// Logically collective
dErr dUnitsCreateUnit(dUnits un,const char *type,const char *longname,const char *shortname,dInt n,const dReal expon[],dUnit *newunit)
{
dErr err;
dUnit unit;
dFunctionBegin;
dValidHeader(un,dUNITS_CLASSID,1);
if (n < 1 || n > dUNITS_MAX) dERROR(((dObject)un)->comm,PETSC_ERR_ARG_OUTOFRANGE,"The number of exponents %D must be positive, but no larger than %D",n,(dInt)dUNITS_MAX);
dValidRealPointer(expon,5);
dValidPointer(newunit,6);
err = dUnitsGetEmptyUnit_Private(un,&unit);dCHK(err);
err = PetscStrallocpy(type,&unit->quantity);dCHK(err);
err = dUnitsAssignName(un,dUnitName,longname,n,expon,&unit->longname);dCHK(err);
err = dUnitsAssignName(un,dUnitShortName,shortname,n,expon,&unit->shortname);dCHK(err);
err = dUnitsAssignName(un,dUnitSIName,NULL,n,expon,&unit->siname);dCHK(err);
unit->toSI = 1.0;
unit->toCommon = 1.0;
for (dInt i=0; i<n; i++) {
dUnit base;
err = dUnitsGetBase(un,i,&base);dCHK(err);
unit->toCommon *= PetscPowScalar(dUnitDimensionalize(base,1.0),expon[i]);
unit->toSI *= PetscPowScalar(dUnitDimensionalizeSI(base,1.0),expon[i]);
unit->expon[i] = expon[i];
}
*newunit = unit;
dFunctionReturn(0);
}
PetscErrorCode IJacobian_Hull1972B4(TS ts, PetscReal t, Vec Y, Vec Ydot, PetscReal a, Mat A, Mat B, void *s)
{
PetscErrorCode ierr;
PetscScalar *y;
PetscInt row[3] = {0,1,2};
PetscScalar value[3][3],fac,fac2;
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
fac = PetscPowScalar(y[0]*y[0]+y[1]*y[1],-1.5);
fac2 = PetscPowScalar(y[0]*y[0]+y[1]*y[1],-0.5);
value[0][0] = a + (y[1]*y[1]*y[2])*fac;
value[0][1] = 1.0 - (y[0]*y[1]*y[2])*fac;
value[0][2] = y[0]*fac2;
value[1][0] = -1.0 - y[0]*y[1]*y[2]*fac;
value[1][1] = a + y[0]*y[0]*y[2]*fac;
value[1][2] = y[1]*fac2;
value[2][0] = -y[1]*y[1]*fac;
value[2][1] = y[0]*y[1]*fac;
value[2][2] = a;
ierr = MatSetValues(A,3,&row[0],3,&row[0],&value[0][0],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);
}
void InitialCondition(TS ts, Vec X)
{
PetscScalar *x;
VecGetArray(X, &x);
for (PetscInt j=0; j<N2; j++) {
for (PetscInt i=0; i<N1; i++) {
for (PetscInt var=0; var<DOF; var++) {
PetscScalar X1Coord = X1_MIN + DX1/2. + i*DX1;
PetscScalar X2Coord = X2_MIN + DX2/2. + j*DX2;
PetscScalar X1Center = (X1_MIN + X1_MAX)/2.;
PetscScalar X2Center = (X2_MIN + X2_MAX)/2.;
PetscScalar r = PetscSqrtScalar(
PetscPowScalar(X1Coord-X1Center, 2.0) +
PetscPowScalar(X2Coord-X2Center, 2.0));
x[INDEX_GLOBAL(i,j,var)] = exp(-r*r/.01);
}
}
}
VecRestoreArray(X, &x);
}
/* Compute the right thickness H = H(x). See lecture notes for exact solution. */
PetscErrorCode FillThicknessAndExactSoln(DM da, AppCtx *user)
{
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx, n, r, Cs, xx, flux, qg, p, B, dudx, ustag;
PetscScalar *H, *uex, *visc;
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);
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/* constants, independent of x */
hx = user->L / (PetscReal)(Mx-1);
n = user->n;
r = user->rho / user->rhow;
Cs = user->A * PetscPowScalar( ( 0.25 * user->rho * user->g * (1.0 - r) ), n);
qg = user->ug * user->Hg;
p = 1.0 + 1.0 / user->n;
B = PetscPowScalar(user->A,-1.0/user->n);
/* Compute regular grid exact soln and staggered-grid thickness over the
locally-owned part of the grid */
ierr = DMDAVecGetArray(da,user->uexact,&uex);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,user->H,&H);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,user->viscosity,&visc);CHKERRQ(ierr);
for (i=xs; i<xs+xm; i++) {
/* get exact velocity and strain rate on regular grid */
xx = hx * (PetscReal)i; /* = x_i = distance from grounding line */
flux = user->accum * xx + qg; /* flux at x_i */
GetUEx(user->ug, qg, user->accum, n, Cs, flux, &(uex[i]), &dudx);
/* exact viscosity on regular grid */
visc[i] = GetViscosityFromStrainRate(dudx, p, B);
/* exact thickness on staggered grid */
flux += user->accum * hx * 0.5; /* flux at x_{i+1/2} */
GetUEx(user->ug, qg, user->accum, n, Cs, flux, &ustag, &dudx);
H[i] = flux / ustag;
}
ierr = DMDAVecRestoreArray(da,user->uexact,&uex);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,user->H,&H);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,user->viscosity,&visc);CHKERRQ(ierr);
/* separately compute and store calving-front values */
flux = user->accum * user->L + qg;
GetUEx(user->ug, qg, user->accum, n, Cs, flux, &(user->uexactcalv), &dudx);
user->Hcalv = flux / user->uexactcalv;
/* strain rate at calving front */
/* MATLAB: gamma = ( 0.25 * p.A^(1/n) * (1 - r) * p.rho * p.g * H(end) )^n; */
user->gamma = 0.25 * PetscPowScalar(user->A,1.0/user->n) * (1.0 - r)
* user->rho * user->g * user->Hcalv;
user->gamma = PetscPowScalar(user->gamma,user->n);
PetscFunctionReturn(0);
}
/* dFSR/d1 = - G / dx, dFSR/d2 = + G / dx */
static inline PetscReal GSR(PetscReal dx, PetscReal eps, PetscReal n,
PetscReal ul, PetscReal ur) {
PetscReal dudx = (ur - ul) / dx,
q = (1.0 / n) - 1.0,
D2 = dudx * dudx + eps * eps;
return PetscPowScalar(D2, (q / 2.0) - 1) * ( q * dudx * dudx + D2 );
}
static inline PetscScalar dFSRdleft(PetscScalar dx, PetscScalar eps, PetscScalar n,
PetscScalar ul, PetscScalar ur) {
PetscScalar dudx = (ur - ul) / dx,
q = (1.0 / n) - 1.0,
D2 = dudx * dudx + eps * eps;
return - (1.0 / dx) * PetscPowScalar(D2, (q / 2.0) - 1) * ( q * dudx * dudx + D2 );
}
PetscScalar Flow_Pipe(Pipe *pipe,PetscScalar hf,PetscScalar ht)
{
PetscScalar flow_pipe;
flow_pipe = PetscSign(hf-ht)*PetscPowScalar(PetscAbsScalar(hf - ht)/pipe->k,(1/pipe->n));
return flow_pipe;
}
PetscErrorCode IFunction(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
DM cda;
DMDACoor2d **coors;
PetscScalar **p,**f,**pdot;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
Vec localX,gc,localXdot;
PetscScalar p_adv1,p_adv2,p_diff;
PetscFunctionBeginUser;
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMGetLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = DMGetLocalVector(user->da,&localXdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(user->da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,localX,&p);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,localXdot,&pdot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,F,&f);CHKERRQ(ierr);
user->disper_coe = PetscPowScalar((user->lambda*user->ws)/(2*user->H),2)*user->q*(1.0-PetscExpScalar(-t/user->lambda));
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
if (i == 0 || j == 0 || i == M-1 || j == N-1) {
ierr = BoundaryConditions(p,coors,i,j,M,N,f,user);CHKERRQ(ierr);
} else {
ierr = adv1(p,coors[j][i].y,i,j,M,&p_adv1,user);CHKERRQ(ierr);
ierr = adv2(p,coors[j][i].x,i,j,N,&p_adv2,user);CHKERRQ(ierr);
ierr = diffuse(p,i,j,t,&p_diff,user);CHKERRQ(ierr);
f[j][i] = -p_adv1 - p_adv2 + p_diff - pdot[j][i];
}
}
}
ierr = DMDAVecRestoreArray(user->da,localX,&p);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,localX,&pdot);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localXdot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,F,&f);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
extern PetscScalar calcmixingr(PetscScalar dtemp, PetscScalar pressure1)
{
PetscScalar e; /* vapor pressure */
PetscScalar mixratio; /* mixing ratio */
dtemp = dtemp - 273; /* converts from Kelvin to Celsuis */
e = 6.11*(PetscPowScalar(10,((7.5*dtemp)/(237.7+dtemp)))); /* converts from dew point temp to vapor pressure */
e = e*100; /* converts from hPa to Pa */
mixratio = (0.622*e)/(pressure1 - e); /* computes mixing ratio */
mixratio = mixratio*1; /* convert to g/Kg */
return mixratio;
}
PetscErrorCode IJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat *J,Mat *Jpre,MatStructure *flg,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
DM cda;
DMDACoor2d **coors;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
Vec gc;
PetscScalar val[5],xi,yi;
MatStencil row,col[5];
PetscScalar c1,c3,c5,c1pos,c1neg,c3pos,c3neg;
PetscFunctionBeginUser;
*flg = SAME_NONZERO_PATTERN;
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
PetscInt nc = 0;
xi = coors[j][i].x; yi = coors[j][i].y;
row.i = i; row.j = j;
c1 = (yi-user->ws)/user->dx;
c1pos = PetscMax(c1,0);
c1neg = PetscMin(c1,0);
c3 = (user->ws/(2.0*user->H))*(user->PM_min - user->Pmax*sin(xi))/user->dy;
c3pos = PetscMax(c3,0);
c3neg = PetscMin(c3,0);
c5 = (PetscPowScalar((user->lambda*user->ws)/(2*user->H),2)*user->q*(1.0-PetscExpScalar(-t/user->lambda)))/(user->dy*user->dy);
col[nc].i = i-1; col[nc].j = j; val[nc++] = c1pos;
col[nc].i = i+1; col[nc].j = j; val[nc++] = -c1neg;
col[nc].i = i; col[nc].j = j-1; val[nc++] = c3pos + c5;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -c3neg + c5;
col[nc].i = i; col[nc].j = j; val[nc++] = -c1pos + c1neg -c3pos + c3neg -2*c5 -a;
ierr = MatSetValuesStencil(*Jpre,1,&row,nc,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (*J != *Jpre) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static inline void GetUEx(PetscScalar ug, PetscScalar qg, PetscScalar a, PetscScalar n,
PetscScalar Cs, PetscScalar flux,
PetscScalar *UEx, PetscScalar *dUdxEx) {
const PetscScalar inside = PetscPowScalar(ug,n+1.0) + (Cs / a)
* (PetscPowScalar(flux,n+1.0) - PetscPowScalar(qg,n+1.0));
*UEx = PetscPowScalar(inside, 1.0 / (n+1.0));
*dUdxEx = Cs * PetscPowScalar(flux, n) * PetscPowScalar(inside, (1.0 / (n+1.0)) - 1.0);
}
static PetscErrorCode FormRHSFunction(TS ts,PetscReal t,Vec X,Vec F,void *ptr)
{
User user = (User)ptr;
DM da;
Vec Xloc;
DMDALocalInfo info;
PetscInt i,j;
PetscReal hx;
Field *x,*f;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
hx = 1.0/(PetscReal)info.mx;
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGetLocalVector(da,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,Xloc,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (i=info.xs; i<info.xs+info.xm; i++) {
const PetscReal *a = user->a;
PetscReal u0t[2] = {1. - PetscPowScalar(sin(12*t),4.),0};
for (j=0; j<2; j++) {
if (i == 0) f[i][j] = a[j]/hx*(1./3*u0t[j] + 0.5*x[i][j] - x[i+1][j] + 1./6*x[i+2][j]);
else if (i == 1) f[i][j] = a[j]/hx*(-1./12*u0t[j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
else if (i == info.mx-2) f[i][j] = a[j]/hx*(-1./6*x[i-2][j] + x[i-1][j] - 0.5*x[i][j] - 1./3*x[i+1][j]);
else if (i == info.mx-1) f[i][j] = a[j]/hx*(-x[i][j] + x[i-1][j]);
else f[i][j] = a[j]/hx*(-1./12*x[i-2][j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,Xloc,&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Compute pointwise residual f(x) over the locally-owned part of the grid
This is a finite difference method. In TeX, the formula we compute is
f_i = \eta_{i+1/2} H_{i+1/2} (u_{i+1}-u_i) - \eta_{i-1/2} H_{i-1/2} (u_i-u_{i-1})
- dx K (H_{i+1/2}^2 - H_{i-1/2}^2)
where
\eta_{i+1/2} = \left|\frac{u_{i+1}-u_i}{dx}\right|^{p-2}
with some regularization using user.epsilon, and
dx = L / Mx
p = 1+1/n
K = rho * g * (1-r) / (4 * B)
r = rho / rhow
B = A^{1/n}
*/
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,PetscScalar *u,PetscScalar *f,AppCtx *user)
{
PetscErrorCode ierr;
PetscReal hx, p, K, B, duL, duR, sL, sR;
PetscScalar *H;
PetscInt i, Mx;
Vec localH;
PetscFunctionBegin;
ierr = DMGetLocalVector(info->da,&localH);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(info->da,user->H,INSERT_VALUES,localH); CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(info->da,user->H,INSERT_VALUES,localH); CHKERRQ(ierr);
p = 1.0 + 1.0 / user->n;
B = PetscPowScalar(user->A,-1.0/user->n);
K = user->rho * user->g * (1.0 - user->rho/user->rhow) / (4.0 * B);
Mx = info->mx;
hx = user->L / ((PetscReal)Mx - 1.0);
ierr = DMDAVecGetArray(info->da,localH,&H);CHKERRQ(ierr);
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0) {
f[0] = u[0] - user->ug; /* Dirichlet condition */
} else {
if (i == 1) { /* use Dirichlet condition as value for neighbor, which symmetrizes */
duL = u[i] - user->ug;
} else {
duL = u[i] - u[i-1];
}
sL = GetEta(duL, hx, p, user->epsilon) * H[i-1] * duL;
if (i == Mx-1) { /* Neumann: calving front stress boundary condition */
duR = u[Mx-2] + 2.0 * hx * user->gamma - u[Mx-1];
} else {
duR = u[i+1] - u[i];
}
sR = GetEta(duR, hx, p, user->epsilon) * H[i] * duR;
f[i] = sR - sL - hx * K * (H[i]*H[i] - H[i-1]*H[i-1]);
}
}
ierr = DMDAVecRestoreArray(info->da,localH,&H);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(info->da,&localH);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode potential_temperature(PetscScalar temp, PetscScalar pressure1, PetscScalar pressure2, PetscScalar sfctemp, PetscScalar *pottemp)
{
PetscScalar kdry; /* poisson constant for dry atmosphere */
PetscScalar pavg; /* average atmospheric pressure */
/* PetscScalar mixratio; mixing ratio */
/* PetscScalar kmoist; poisson constant for moist atmosphere */
PetscFunctionBeginUser;
/* mixratio = calcmixingr(sfctemp,pressure1); */
/* initialize poisson constant */
kdry = 0.2854;
/* kmoist = 0.2854*(1 - 0.24*mixratio); */
pavg = ((0.7*pressure1)+pressure2)/2; /* calculates simple average press */
*pottemp = temp*(PetscPowScalar((pressure1/pavg),kdry)); /* calculates potential temperature */
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscErrorCode ierr;
Vec X,Y;
PetscReal enorm,hfac_lte,h_lte,safety;
PetscInt order,stepno;
PetscFunctionBegin;
ierr = TSGetTimeStepNumber(ts,&stepno);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
if (!basic->Y) {ierr = VecDuplicate(X,&basic->Y);CHKERRQ(ierr);}
Y = basic->Y;
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,Y,NULL);CHKERRQ(ierr);
safety = basic->safety;
ierr = TSErrorNormWRMS(ts,Y,&enorm);CHKERRQ(ierr);
if (enorm > 1.) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
hfac_lte = safety * PetscRealPart(PetscPowScalar((PetscScalar)enorm,(PetscReal)(-1./order)));
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_sc = 0;
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
/* Computes the wind speed using Weibull distribution */
PetscErrorCode WindSpeeds(AppCtx *user)
{
PetscErrorCode ierr;
PetscScalar *x,*t,avg_dev,sum;
PetscInt i;
PetscFunctionBegin;
user->cw = 5;
user->kw = 2; /* Rayleigh distribution */
user->nsamples = 2000;
user->Tw = 0.2;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,PETSC_NULL,"Wind Speed Options","");CHKERRQ(ierr);
{
ierr = PetscOptionsReal("-cw","","",user->cw,&user->cw,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-kw","","",user->kw,&user->kw,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-nsamples","","",user->nsamples,&user->nsamples,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-Tw","","",user->Tw,&user->Tw,PETSC_NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&user->wind_data);CHKERRQ(ierr);
ierr = VecSetSizes(user->wind_data,PETSC_DECIDE,user->nsamples);CHKERRQ(ierr);
ierr = VecSetFromOptions(user->wind_data);CHKERRQ(ierr);
ierr = VecDuplicate(user->wind_data,&user->t_wind);CHKERRQ(ierr);
ierr = VecGetArray(user->t_wind,&t);CHKERRQ(ierr);
for(i=0;i < user->nsamples;i++) t[i] = (i+1)*tmax/user->nsamples;
ierr = VecRestoreArray(user->t_wind,&t);CHKERRQ(ierr);
/* Wind speed deviation = (-log(rand)/cw)^(1/kw) */
ierr = VecSetRandom(user->wind_data,PETSC_NULL);CHKERRQ(ierr);
ierr = VecLog(user->wind_data);CHKERRQ(ierr);
ierr = VecScale(user->wind_data,-1/user->cw);CHKERRQ(ierr);
ierr = VecGetArray(user->wind_data,&x);CHKERRQ(ierr);
for(i=0;i < user->nsamples;i++) {
x[i] = PetscPowScalar(x[i],(1/user->kw));
}
ierr = VecRestoreArray(user->wind_data,&x);CHKERRQ(ierr);
ierr = VecSum(user->wind_data,&sum);CHKERRQ(ierr);
avg_dev = sum/user->nsamples;
/* Wind speed (t) = (1 + wind speed deviation(t) - avg_dev)*average wind speed */
ierr = VecShift(user->wind_data,(1-avg_dev));CHKERRQ(ierr);
ierr = VecScale(user->wind_data,vwa);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
VecPow - Replaces each component of a vector by x_i^p
Logically Collective on v
Input Parameter:
+ v - the vector
- p - the exponent to use on each element
Output Parameter:
. v - the vector
Level: intermediate
@*/
PetscErrorCode VecPow(Vec v, PetscScalar p)
{
PetscErrorCode ierr;
PetscInt n,i;
PetscScalar *v1;
PetscFunctionBegin;
PetscValidHeaderSpecific(v, VEC_CLASSID, 1);
ierr = VecGetArray(v, &v1);CHKERRQ(ierr);
ierr = VecGetLocalSize(v, &n);CHKERRQ(ierr);
if (1.0 == p) {
} else if (-1.0 == p) {
for (i = 0; i < n; ++i){
v1[i] = 1.0 / v1[i];
}
} else if (0.0 == p) {
for (i = 0; i < n; ++i){
/* Not-a-number left alone
Infinity set to one */
if (v1[i] == v1[i]) {
v1[i] = 1.0;
}
}
} else if (0.5 == p) {
for (i = 0; i < n; ++i) {
if (PetscRealPart(v1[i]) >= 0) {
v1[i] = PetscSqrtScalar(v1[i]);
} else {
v1[i] = PETSC_INFINITY;
}
}
} else if (-0.5 == p) {
for (i = 0; i < n; ++i) {
if (PetscRealPart(v1[i]) >= 0) {
v1[i] = 1.0 / PetscSqrtScalar(v1[i]);
} else {
v1[i] = PETSC_INFINITY;
}
}
} else if (2.0 == p) {
for (i = 0; i < n; ++i){
v1[i] *= v1[i];
}
} else if (-2.0 == p) {
for (i = 0; i < n; ++i){
v1[i] = 1.0 / (v1[i] * v1[i]);
}
} else {
for (i = 0; i < n; ++i) {
if (PetscRealPart(v1[i]) >= 0) {
v1[i] = PetscPowScalar(v1[i], p);
} else {
v1[i] = PETSC_INFINITY;
}
}
}
ierr = VecRestoreArray(v,&v1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static inline PetscScalar GetViscosityFromStrainRate(PetscScalar dudx, PetscScalar p,
PetscScalar B) {
return B * PetscPowScalar(dudx * dudx, (p - 2.0) / 2.0 );
}
static inline PetscScalar GetEta(PetscScalar Z, PetscScalar dx, PetscScalar p, PetscScalar eps) {
return PetscPowScalar((Z/dx) * (Z/dx) + eps * eps, (p - 2.0) / 2.0 );
}
PetscErrorCode ini_bou(Vec X,AppCtx* user)
{
PetscErrorCode ierr;
DM cda;
DMDACoor2d **coors;
PetscScalar **p;
Vec gc;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
PetscScalar xi,yi;
PetscScalar sigmax=user->sigmax,sigmay=user->sigmay;
PetscScalar rho =user->rho;
PetscScalar mux =user->mux,muy=user->muy;
PetscMPIInt rank;
PetscScalar sum;
PetscFunctionBeginUser;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
user->dx = (user->xmax - user->xmin)/(M-1); user->dy = (user->ymax - user->ymin)/(N-1);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinates(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,X,&p);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
/* mux and muy need to be grid points in the x and y-direction otherwise the solution goes unstable
muy is set by choosing the y domain, no. of grid points along y-direction so that muy is a grid point
in the y-direction. We only modify mux here
*/
mux = user->mux = coors[0][M/2+10].x; /* For -pi < x < pi, this should be some angle between 0 and pi/2 */
if (user->nonoiseinitial) {
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
if ((xi == mux) && (yi == muy)) {
p[j][i] = 1.0;
}
}
}
} else {
/* Change PM_min accordingly */
user->PM_min = user->Pmax*sin(mux);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
p[j][i] = (0.5/(PETSC_PI*sigmax*sigmay*PetscSqrtScalar(1.0-rho*rho)))*PetscExpScalar(-0.5/(1-rho*rho)*(PetscPowScalar((xi-mux)/sigmax,2) + PetscPowScalar((yi-muy)/sigmay,2) - 2*rho*(xi-mux)*(yi-muy)/(sigmax*sigmay)));
}
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,X,&p);CHKERRQ(ierr);
ierr = VecSum(X,&sum);CHKERRQ(ierr);
ierr = VecScale(X,1.0/sum);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static inline PetscScalar GetDEta(PetscScalar Z, PetscScalar dx, PetscScalar p, PetscScalar eps) {
return ((p - 2.0) / (dx * dx)) * Z *
PetscPowScalar((Z/dx) * (Z/dx) + eps * eps, (p - 4.0) / 2.0 );
}
PetscErrorCode ini_bou(Vec X,AppCtx* user)
{
PetscErrorCode ierr;
DM cda;
DMDACoor2d **coors;
PetscScalar **p;
Vec gc;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
PetscScalar xi,yi;
PetscScalar sigmax=user->sigmax,sigmay=user->sigmay;
PetscScalar rho =user->rho;
PetscScalar mux =user->mux,muy=user->muy;
PetscMPIInt rank;
PetscFunctionBeginUser;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
user->dx = (user->xmax - user->xmin)/(M-1); user->dy = (user->ymax - user->ymin)/(N-1);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinates(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,X,&p);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
if (i == 0 || j == 0 || i == M-1 || j == N-1) p[j][i] = 0.0;
else p[j][i] = (0.5/(PETSC_PI*sigmax*sigmay*PetscSqrtScalar(1.0-rho*rho)))*PetscExpScalar(-0.5/(1-rho*rho)*(PetscPowScalar((xi-mux)/sigmax,2) + PetscPowScalar((yi-muy)/sigmay,2) - 2*rho*(xi-mux)*(yi-muy)/(sigmax*sigmay)));
}
}
/* p[N/2+N%2][M/2+M%2] = 1/(user->dx*user->dy); */
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,X,&p);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
SNES snes; /* SNES context */
Vec x,r,F,U; /* vectors */
Mat J; /* Jacobian matrix */
MonitorCtx monP; /* monitoring context */
PetscErrorCode ierr;
PetscInt its,n = 5,i,maxit,maxf;
PetscMPIInt size;
PetscScalar h,xp,v,none = -1.0;
PetscReal abstol,rtol,stol,norm;
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This is a uniprocessor example only!");
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
h = 1.0/(n-1);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create nonlinear solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create vector data structures; set function evaluation routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Note that we form 1 vector from scratch and then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
ierr = VecDuplicate(x,&F);CHKERRQ(ierr);
ierr = VecDuplicate(x,&U);CHKERRQ(ierr);
/*
Set function evaluation routine and vector
*/
ierr = SNESSetFunction(snes,r,FormFunction,(void*)F);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix data structure; set Jacobian evaluation routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(J,3,NULL);CHKERRQ(ierr);
/*
Set Jacobian matrix data structure and default Jacobian evaluation
routine. User can override with:
-snes_fd : default finite differencing approximation of Jacobian
-snes_mf : matrix-free Newton-Krylov method with no preconditioning
(unless user explicitly sets preconditioner)
-snes_mf_operator : form preconditioning matrix as set by the user,
but use matrix-free approx for Jacobian-vector
products within Newton-Krylov method
*/
ierr = SNESSetJacobian(snes,J,J,FormJacobian,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize nonlinear solver; set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Set an optional user-defined monitoring routine
*/
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,0,0,0,400,400,&monP.viewer);CHKERRQ(ierr);
ierr = SNESMonitorSet(snes,Monitor,&monP,0);CHKERRQ(ierr);
/*
Set names for some vectors to facilitate monitoring (optional)
*/
ierr = PetscObjectSetName((PetscObject)x,"Approximate Solution");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)U,"Exact Solution");CHKERRQ(ierr);
/*
Set SNES/KSP/KSP/PC runtime options, e.g.,
-snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
*/
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
/*
Print parameters used for convergence testing (optional) ... just
to demonstrate this routine; this information is also printed with
the option -snes_view
*/
ierr = SNESGetTolerances(snes,&abstol,&rtol,&stol,&maxit,&maxf);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"atol=%G, rtol=%G, stol=%G, maxit=%D, maxf=%D\n",abstol,rtol,stol,maxit,maxf);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize application:
Store right-hand-side of PDE and exact solution
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
xp = 0.0;
for (i=0; i<n; i++) {
v = 6.0*xp + PetscPowScalar(xp+1.e-12,6.0); /* +1.e-12 is to prevent 0^6 */
ierr = VecSetValues(F,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
v = xp*xp*xp;
ierr = VecSetValues(U,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
xp += h;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Evaluate initial guess; then solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Note: The user should initialize the vector, x, with the initial guess
for the nonlinear solver prior to calling SNESSolve(). In particular,
to employ an initial guess of zero, the user should explicitly set
this vector to zero by calling VecSet().
*/
ierr = FormInitialGuess(x);CHKERRQ(ierr);
ierr = SNESSolve(snes,NULL,x);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"number of SNES iterations = %D\n\n",its);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,none,U);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %G, Iterations %D\n",norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&F);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&monP.viewer);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode IJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat *J,Mat *Jpre,MatStructure *flg,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
DM cda;
DMDACoor2d **coors;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
Vec gc;
PetscScalar val[5],xi,yi;
MatStencil row,col[5];
PetscScalar c1,c3,c5;
PetscFunctionBeginUser;
*flg = SAME_NONZERO_PATTERN;
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
PetscInt nc = 0;
row.i = i; row.j = j;
if (i == 0 || j == 0 || i == M-1 || j == N-1) {
if (user->bc == 0) {
col[nc].i = i; col[nc].j = j; val[nc++] = 1.0;
} else {
PetscScalar fthetac,fwc;
fthetac = user->ws/(2*user->H)*(user->PM_min - user->Pmax*sin(xi));
fwc = (yi*yi/2.0 - user->ws*yi);
if (i==0 && j==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac + user->disper_coe/user->dy;
} else if (i==0 && j == N-1) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac - user->disper_coe/user->dy;
} else if (i== M-1 && j == 0) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac + user->disper_coe/user->dy;
} else if (i == M-1 && j == N-1) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac - user->disper_coe/user->dy;
} else if (i==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j; val[nc++] = -fwc/user->dx + fthetac;
} else if (i == M-1) {
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/user->dx;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/(2*user->dy);
col[nc].i = i; col[nc].j = j; val[nc++] = fwc/user->dx + fthetac;
} else if (j==0) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/(2*user->dx);
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/(2*user->dx);
col[nc].i = i; col[nc].j = j+1; val[nc++] = -user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = user->disper_coe/user->dy + fthetac;
} else if (j == N-1) {
col[nc].i = i+1; col[nc].j = j; val[nc++] = fwc/(2*user->dx);
col[nc].i = i-1; col[nc].j = j; val[nc++] = -fwc/(2*user->dx);
col[nc].i = i; col[nc].j = j-1; val[nc++] = user->disper_coe/user->dy;
col[nc].i = i; col[nc].j = j; val[nc++] = -user->disper_coe/user->dy + fthetac;
}
}
} else {
c1 = (yi-user->ws)/(2*user->dx);
c3 = (user->ws/(2.0*user->H))*(user->PM_min - user->Pmax*sin(xi))/(2*user->dy);
c5 = (PetscPowScalar((user->lambda*user->ws)/(2*user->H),2)*user->q*(1.0-PetscExpScalar(-t/user->lambda)))/(user->dy*user->dy);
col[nc].i = i-1; col[nc].j = j; val[nc++] = c1;
col[nc].i = i+1; col[nc].j = j; val[nc++] = -c1;
col[nc].i = i; col[nc].j = j-1; val[nc++] = c3 + c5;
col[nc].i = i; col[nc].j = j+1; val[nc++] = -c3 + c5;
col[nc].i = i; col[nc].j = j; val[nc++] = -2*c5 -a;
}
ierr = MatSetValuesStencil(*Jpre,1,&row,nc,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (*J != *Jpre) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/* define a power of the strain rate: F \approx |u_x|^q u_x
note F(ul,ur) = - F(ur,ul) */
static inline PetscScalar GetFSR(PetscScalar dx, PetscScalar eps, PetscScalar n,
PetscScalar ul, PetscScalar ur) {
PetscScalar dudx = (ur - ul) / dx,
q = (1.0 / n) - 1.0;
return PetscPowScalar(dudx * dudx + eps * eps, q / 2.0) * dudx;
}
PetscErrorCode FormFunction(SNES snes,Vec X,Vec F,void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i,j,mx,my,xs,ys,xm,ym;
PetscScalar zero = 0.0,one = 1.0;
PetscScalar hx,hy,hxdhy,hydhx;
PetscScalar t0,tn,ts,te,tw,an,as,ae,aw,dn,ds,de,dw,fn = 0.0,fs = 0.0,fe =0.0,fw = 0.0;
PetscScalar tleft,tright,beta;
PetscScalar **x,**f;
Vec localX;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,NULL,&mx,&my,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
hx = one/(PetscReal)(mx-1); hy = one/(PetscReal)(my-1);
hxdhy = hx/hy; hydhx = hy/hx;
tleft = user->tleft; tright = user->tright;
beta = user->beta;
/* Get ghost points */
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* Evaluate function */
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
t0 = x[j][i];
if (i > 0 && i < mx-1 && j > 0 && j < my-1) {
/* general interior volume */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
dw = PetscPowScalar(aw,beta);
fw = dw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
de = PetscPowScalar(ae,beta);
fe = de*(te - t0);
ts = x[j-1][i];
as = 0.5*(t0 + ts);
ds = PetscPowScalar(as,beta);
fs = ds*(t0 - ts);
tn = x[j+1][i];
an = 0.5*(t0 + tn);
dn = PetscPowScalar(an,beta);
fn = dn*(tn - t0);
} else if (i == 0) {
/* left-hand boundary */
tw = tleft;
aw = 0.5*(t0 + tw);
dw = PetscPowScalar(aw,beta);
fw = dw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
de = PetscPowScalar(ae,beta);
fe = de*(te - t0);
if (j > 0) {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
ds = PetscPowScalar(as,beta);
fs = ds*(t0 - ts);
} else fs = zero;
if (j < my-1) {
tn = x[j+1][i];
an = 0.5*(t0 + tn);
dn = PetscPowScalar(an,beta);
fn = dn*(tn - t0);
} else fn = zero;
} else if (i == mx-1) {
/* right-hand boundary */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
dw = PetscPowScalar(aw,beta);
fw = dw*(t0 - tw);
te = tright;
ae = 0.5*(t0 + te);
de = PetscPowScalar(ae,beta);
fe = de*(te - t0);
if (j > 0) {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
ds = PetscPowScalar(as,beta);
fs = ds*(t0 - ts);
} else fs = zero;
if (j < my-1) {
tn = x[j+1][i];
an = 0.5*(t0 + tn);
dn = PetscPowScalar(an,beta);
fn = dn*(tn - t0);
} else fn = zero;
} else if (j == 0) {
/* bottom boundary,and i <> 0 or mx-1 */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
dw = PetscPowScalar(aw,beta);
fw = dw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
de = PetscPowScalar(ae,beta);
fe = de*(te - t0);
fs = zero;
tn = x[j+1][i];
an = 0.5*(t0 + tn);
dn = PetscPowScalar(an,beta);
fn = dn*(tn - t0);
} else if (j == my-1) {
/* top boundary,and i <> 0 or mx-1 */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
dw = PetscPowScalar(aw,beta);
fw = dw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
de = PetscPowScalar(ae,beta);
fe = de*(te - t0);
ts = x[j-1][i];
as = 0.5*(t0 + ts);
ds = PetscPowScalar(as,beta);
fs = ds*(t0 - ts);
fn = zero;
}
f[j][i] = -hydhx*(fe-fw) - hxdhy*(fn-fs);
}
}
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops((22.0 + 4.0*POWFLOP)*ym*xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormJacobian(SNES snes,Vec X,Mat jac,Mat B,void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i,j,mx,my,xs,ys,xm,ym;
PetscScalar one = 1.0,hx,hy,hxdhy,hydhx,t0,tn,ts,te,tw;
PetscScalar dn,ds,de,dw,an,as,ae,aw,bn,bs,be,bw,gn,gs,ge,gw;
PetscScalar tleft,tright,beta,bm1,coef;
PetscScalar v[5],**x;
Vec localX;
MatStencil col[5],row;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,NULL,&mx,&my,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
hx = one/(PetscReal)(mx-1); hy = one/(PetscReal)(my-1);
hxdhy = hx/hy; hydhx = hy/hx;
tleft = user->tleft; tright = user->tright;
beta = user->beta; bm1 = user->bm1; coef = user->coef;
/* Get ghost points */
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
/* Evaluate Jacobian of function */
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
t0 = x[j][i];
if (i > 0 && i < mx-1 && j > 0 && j < my-1) {
/* general interior volume */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
bw = PetscPowScalar(aw,bm1);
/* dw = bw * aw */
dw = PetscPowScalar(aw,beta);
gw = coef*bw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
be = PetscPowScalar(ae,bm1);
/* de = be * ae; */
de = PetscPowScalar(ae,beta);
ge = coef*be*(te - t0);
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = -hydhx*(dw - gw); col[1].j = j; col[1].i = i-1;
v[2] = hxdhy*(ds + dn + gs - gn) + hydhx*(dw + de + gw - ge); col[2].j = row.j = j; col[2].i = row.i = i;
v[3] = -hydhx*(de + ge); col[3].j = j; col[3].i = i+1;
v[4] = -hxdhy*(dn + gn); col[4].j = j+1; col[4].i = i;
ierr = MatSetValuesStencil(jac,1,&row,5,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else if (i == 0) {
/* left-hand boundary */
tw = tleft;
aw = 0.5*(t0 + tw);
bw = PetscPowScalar(aw,bm1);
/* dw = bw * aw */
dw = PetscPowScalar(aw,beta);
gw = coef*bw*(t0 - tw);
te = x[j][i + 1];
ae = 0.5*(t0 + te);
be = PetscPowScalar(ae,bm1);
/* de = be * ae; */
de = PetscPowScalar(ae,beta);
ge = coef*be*(te - t0);
/* left-hand bottom boundary */
if (j == 0) {
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = hxdhy*(dn - gn) + hydhx*(dw + de + gw - ge); col[0].j = row.j = j; col[0].i = row.i = i;
v[1] = -hydhx*(de + ge); col[1].j = j; col[1].i = i+1;
v[2] = -hxdhy*(dn + gn); col[2].j = j+1; col[2].i = i;
ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
/* left-hand interior boundary */
} else if (j < my-1) {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = hxdhy*(ds + dn + gs - gn) + hydhx*(dw + de + gw - ge); col[1].j = row.j = j; col[1].i = row.i = i;
v[2] = -hydhx*(de + ge); col[2].j = j; col[2].i = i+1;
v[3] = -hxdhy*(dn + gn); col[3].j = j+1; col[3].i = i;
ierr = MatSetValuesStencil(jac,1,&row,4,col,v,INSERT_VALUES);CHKERRQ(ierr);
/* left-hand top boundary */
} else {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = hxdhy*(ds + gs) + hydhx*(dw + de + gw - ge); col[1].j = row.j = j; col[1].i = row.i = i;
v[2] = -hydhx*(de + ge); col[2].j = j; col[2].i = i+1;
ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
} else if (i == mx-1) {
/* right-hand boundary */
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
bw = PetscPowScalar(aw,bm1);
/* dw = bw * aw */
dw = PetscPowScalar(aw,beta);
gw = coef*bw*(t0 - tw);
te = tright;
ae = 0.5*(t0 + te);
be = PetscPowScalar(ae,bm1);
/* de = be * ae; */
de = PetscPowScalar(ae,beta);
ge = coef*be*(te - t0);
/* right-hand bottom boundary */
if (j == 0) {
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = -hydhx*(dw - gw); col[0].j = j; col[0].i = i-1;
v[1] = hxdhy*(dn - gn) + hydhx*(dw + de + gw - ge); col[1].j = row.j = j; col[1].i = row.i = i;
v[2] = -hxdhy*(dn + gn); col[2].j = j+1; col[2].i = i;
ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
/* right-hand interior boundary */
} else if (j < my-1) {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = -hydhx*(dw - gw); col[1].j = j; col[1].i = i-1;
v[2] = hxdhy*(ds + dn + gs - gn) + hydhx*(dw + de + gw - ge); col[2].j = row.j = j; col[2].i = row.i = i;
v[3] = -hxdhy*(dn + gn); col[3].j = j+1; col[3].i = i;
ierr = MatSetValuesStencil(jac,1,&row,4,col,v,INSERT_VALUES);CHKERRQ(ierr);
/* right-hand top boundary */
} else {
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = -hydhx*(dw - gw); col[1].j = j; col[1].i = i-1;
v[2] = hxdhy*(ds + gs) + hydhx*(dw + de + gw - ge); col[2].j = row.j = j; col[2].i = row.i = i;
ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
/* bottom boundary,and i <> 0 or mx-1 */
} else if (j == 0) {
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
bw = PetscPowScalar(aw,bm1);
/* dw = bw * aw */
dw = PetscPowScalar(aw,beta);
gw = coef*bw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
be = PetscPowScalar(ae,bm1);
/* de = be * ae; */
de = PetscPowScalar(ae,beta);
ge = coef*be*(te - t0);
tn = x[j+1][i];
an = 0.5*(t0 + tn);
bn = PetscPowScalar(an,bm1);
/* dn = bn * an; */
dn = PetscPowScalar(an,beta);
gn = coef*bn*(tn - t0);
v[0] = -hydhx*(dw - gw); col[0].j = j; col[0].i = i-1;
v[1] = hxdhy*(dn - gn) + hydhx*(dw + de + gw - ge); col[1].j = row.j = j; col[1].i = row.i = i;
v[2] = -hydhx*(de + ge); col[2].j = j; col[2].i = i+1;
v[3] = -hxdhy*(dn + gn); col[3].j = j+1; col[3].i = i;
ierr = MatSetValuesStencil(jac,1,&row,4,col,v,INSERT_VALUES);CHKERRQ(ierr);
/* top boundary,and i <> 0 or mx-1 */
} else if (j == my-1) {
tw = x[j][i-1];
aw = 0.5*(t0 + tw);
bw = PetscPowScalar(aw,bm1);
/* dw = bw * aw */
dw = PetscPowScalar(aw,beta);
gw = coef*bw*(t0 - tw);
te = x[j][i+1];
ae = 0.5*(t0 + te);
be = PetscPowScalar(ae,bm1);
/* de = be * ae; */
de = PetscPowScalar(ae,beta);
ge = coef*be*(te - t0);
ts = x[j-1][i];
as = 0.5*(t0 + ts);
bs = PetscPowScalar(as,bm1);
/* ds = bs * as; */
ds = PetscPowScalar(as,beta);
gs = coef*bs*(t0 - ts);
v[0] = -hxdhy*(ds - gs); col[0].j = j-1; col[0].i = i;
v[1] = -hydhx*(dw - gw); col[1].j = j; col[1].i = i-1;
v[2] = hxdhy*(ds + gs) + hydhx*(dw + de + gw - ge); col[2].j = row.j = j; col[2].i = row.i = i;
v[3] = -hydhx*(de + ge); col[3].j = j; col[3].i = i+1;
ierr = MatSetValuesStencil(jac,1,&row,4,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops((41.0 + 8.0*POWFLOP)*xm*ym);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode ResidualFunction(SNES snes,Vec X, Vec F, Userctx *user)
{
PetscErrorCode ierr;
Vec Xgen,Xnet,Fgen,Fnet;
PetscScalar *xgen,*xnet,*fgen,*fnet;
PetscInt i,idx=0;
PetscScalar Vr,Vi,Vm,Vm2;
PetscScalar Eqp,Edp,delta,w; /* Generator variables */
PetscScalar Efd,RF,VR; /* Exciter variables */
PetscScalar Id,Iq; /* Generator dq axis currents */
PetscScalar Vd,Vq,SE;
PetscScalar IGr,IGi,IDr,IDi;
PetscScalar Zdq_inv[4],det;
PetscScalar PD,QD,Vm0,*v0;
PetscInt k;
PetscFunctionBegin;
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Fgen,&Fnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,F,Fgen,Fnet);CHKERRQ(ierr);
/* Network current balance residual IG + Y*V + IL = 0. Only YV is added here.
The generator current injection, IG, and load current injection, ID are added later
*/
/* Note that the values in Ybus are stored assuming the imaginary current balance
equation is ordered first followed by real current balance equation for each bus.
Thus imaginary current contribution goes in location 2*i, and
real current contribution in 2*i+1
*/
ierr = MatMult(user->Ybus,Xnet,Fnet);
ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = VecGetArray(Fgen,&fgen);CHKERRQ(ierr);
ierr = VecGetArray(Fnet,&fnet);CHKERRQ(ierr);
/* Generator subsystem */
for (i=0; i < ngen; i++) {
Eqp = xgen[idx];
Edp = xgen[idx+1];
delta = xgen[idx+2];
w = xgen[idx+3];
Id = xgen[idx+4];
Iq = xgen[idx+5];
Efd = xgen[idx+6];
RF = xgen[idx+7];
VR = xgen[idx+8];
/* Generator differential equations */
fgen[idx] = (Eqp + (Xd[i] - Xdp[i])*Id - Efd)/Td0p[i];
fgen[idx+1] = (Edp - (Xq[i] - Xqp[i])*Iq)/Tq0p[i];
fgen[idx+2] = -w + w_s;
fgen[idx+3] = (-TM[i] + Edp*Id + Eqp*Iq + (Xqp[i] - Xdp[i])*Id*Iq + D[i]*(w - w_s))/M[i];
Vr = xnet[2*gbus[i]]; /* Real part of generator terminal voltage */
Vi = xnet[2*gbus[i]+1]; /* Imaginary part of the generator terminal voltage */
ierr = ri2dq(Vr,Vi,delta,&Vd,&Vq);CHKERRQ(ierr);
/* Algebraic equations for stator currents */
det = Rs[i]*Rs[i] + Xdp[i]*Xqp[i];
Zdq_inv[0] = Rs[i]/det;
Zdq_inv[1] = Xqp[i]/det;
Zdq_inv[2] = -Xdp[i]/det;
Zdq_inv[3] = Rs[i]/det;
fgen[idx+4] = Zdq_inv[0]*(-Edp + Vd) + Zdq_inv[1]*(-Eqp + Vq) + Id;
fgen[idx+5] = Zdq_inv[2]*(-Edp + Vd) + Zdq_inv[3]*(-Eqp + Vq) + Iq;
/* Add generator current injection to network */
ierr = dq2ri(Id,Iq,delta,&IGr,&IGi);CHKERRQ(ierr);
fnet[2*gbus[i]] -= IGi;
fnet[2*gbus[i]+1] -= IGr;
Vm = PetscSqrtScalar(Vd*Vd + Vq*Vq); Vm2 = Vm*Vm;
SE = k1[i]*PetscExpScalar(k2[i]*Efd);
/* Exciter differential equations */
fgen[idx+6] = (KE[i]*Efd + SE - VR)/TE[i];
fgen[idx+7] = (RF - KF[i]*Efd/TF[i])/TF[i];
fgen[idx+8] = (VR - KA[i]*RF + KA[i]*KF[i]*Efd/TF[i] - KA[i]*(Vref[i] - Vm))/TA[i];
idx = idx + 9;
}
ierr = VecGetArray(user->V0,&v0);CHKERRQ(ierr);
for (i=0; i < nload; i++) {
Vr = xnet[2*lbus[i]]; /* Real part of load bus voltage */
Vi = xnet[2*lbus[i]+1]; /* Imaginary part of the load bus voltage */
Vm = PetscSqrtScalar(Vr*Vr + Vi*Vi); Vm2 = Vm*Vm;
Vm0 = PetscSqrtScalar(v0[2*lbus[i]]*v0[2*lbus[i]] + v0[2*lbus[i]+1]*v0[2*lbus[i]+1]);
PD = QD = 0.0;
for (k=0; k < ld_nsegsp[i]; k++) PD += ld_alphap[k]*PD0[i]*PetscPowScalar((Vm/Vm0),ld_betap[k]);
for (k=0; k < ld_nsegsq[i]; k++) QD += ld_alphaq[k]*QD0[i]*PetscPowScalar((Vm/Vm0),ld_betaq[k]);
/* Load currents */
IDr = (PD*Vr + QD*Vi)/Vm2;
IDi = (-QD*Vr + PD*Vi)/Vm2;
fnet[2*lbus[i]] += IDi;
fnet[2*lbus[i]+1] += IDr;
}
ierr = VecRestoreArray(user->V0,&v0);CHKERRQ(ierr);
ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = VecRestoreArray(Fgen,&fgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Fnet,&fnet);CHKERRQ(ierr);
ierr = DMCompositeGather(user->dmpgrid,F,INSERT_VALUES,Fgen,Fnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Fgen,&Fnet);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode Tao_mcstep(TaoLineSearch ls,PetscReal *stx,PetscReal *fx,PetscReal *dx,PetscReal *sty,PetscReal *fy,PetscReal *dy,PetscReal *stp,PetscReal *fp,PetscReal *dp)
{
TaoLineSearch_MT *mtP = (TaoLineSearch_MT *) ls->data;
PetscReal gamma1, p, q, r, s, sgnd, stpc, stpf, stpq, theta;
PetscInt bound;
PetscFunctionBegin;
/* Check the input parameters for errors */
mtP->infoc = 0;
if (mtP->bracket && (*stp <= PetscMin(*stx,*sty) || (*stp >= PetscMax(*stx,*sty)))) SETERRQ(PETSC_COMM_SELF,1,"bad stp in bracket");
if (*dx * (*stp-*stx) >= 0.0) SETERRQ(PETSC_COMM_SELF,1,"dx * (stp-stx) >= 0.0");
if (ls->stepmax < ls->stepmin) SETERRQ(PETSC_COMM_SELF,1,"stepmax > stepmin");
/* Determine if the derivatives have opposite sign */
sgnd = *dp * (*dx / PetscAbsReal(*dx));
if (*fp > *fx) {
/* Case 1: a higher function value.
The minimum is bracketed. If the cubic step is closer
to stx than the quadratic step, the cubic step is taken,
else the average of the cubic and quadratic steps is taken. */
mtP->infoc = 1;
bound = 1;
theta = 3 * (*fx - *fp) / (*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp < *stx) gamma1 = -gamma1;
/* Can p be 0? Check */
p = (gamma1 - *dx) + theta;
q = ((gamma1 - *dx) + gamma1) + *dp;
r = p/q;
stpc = *stx + r*(*stp - *stx);
stpq = *stx + ((*dx/((*fx-*fp)/(*stp-*stx)+*dx))*0.5) * (*stp - *stx);
if (PetscAbsReal(stpc-*stx) < PetscAbsReal(stpq-*stx)) {
stpf = stpc;
} else {
stpf = stpc + 0.5*(stpq - stpc);
}
mtP->bracket = 1;
} else if (sgnd < 0.0) {
/* Case 2: A lower function value and derivatives of
opposite sign. The minimum is bracketed. If the cubic
step is closer to stx than the quadratic (secant) step,
the cubic step is taken, else the quadratic step is taken. */
mtP->infoc = 2;
bound = 0;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dx;
r = p/q;
stpc = *stp + r*(*stx - *stp);
stpq = *stp + (*dp/(*dp-*dx))*(*stx - *stp);
if (PetscAbsReal(stpc-*stp) > PetscAbsReal(stpq-*stp)) {
stpf = stpc;
} else {
stpf = stpq;
}
mtP->bracket = 1;
} else if (PetscAbsReal(*dp) < PetscAbsReal(*dx)) {
/* Case 3: A lower function value, derivatives of the
same sign, and the magnitude of the derivative decreases.
The cubic step is only used if the cubic tends to infinity
in the direction of the step or if the minimum of the cubic
is beyond stp. Otherwise the cubic step is defined to be
either stepmin or stepmax. The quadratic (secant) step is also
computed and if the minimum is bracketed then the step
closest to stx is taken, else the step farthest away is taken. */
mtP->infoc = 3;
bound = 1;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
/* The case gamma1 = 0 only arises if the cubic does not tend
to infinity in the direction of the step. */
gamma1 = s*PetscSqrtScalar(PetscMax(0.0,PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s)));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = (gamma1 + (*dx - *dp)) + gamma1;
r = p/q;
if (r < 0.0 && gamma1 != 0.0) stpc = *stp + r*(*stx - *stp);
else if (*stp > *stx) stpc = ls->stepmax;
else stpc = ls->stepmin;
stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
if (mtP->bracket) {
if (PetscAbsReal(*stp-stpc) < PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
} else {
if (PetscAbsReal(*stp-stpc) > PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
}
} else {
/* Case 4: A lower function value, derivatives of the
same sign, and the magnitude of the derivative does
not decrease. If the minimum is not bracketed, the step
is either stpmin or stpmax, else the cubic step is taken. */
mtP->infoc = 4;
bound = 0;
if (mtP->bracket) {
theta = 3*(*fp - *fy)/(*sty - *stp) + *dy + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dy));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dy/s)*(*dp/s));
if (*stp > *sty) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dy;
r = p/q;
stpc = *stp + r*(*sty - *stp);
stpf = stpc;
} else if (*stp > *stx) {
stpf = ls->stepmax;
} else {
stpf = ls->stepmin;
}
}
/* Update the interval of uncertainty. This update does not
depend on the new step or the case analysis above. */
if (*fp > *fx) {
*sty = *stp;
*fy = *fp;
*dy = *dp;
} else {
if (sgnd < 0.0) {
*sty = *stx;
*fy = *fx;
*dy = *dx;
}
*stx = *stp;
*fx = *fp;
*dx = *dp;
}
/* Compute the new step and safeguard it. */
stpf = PetscMin(ls->stepmax,stpf);
stpf = PetscMax(ls->stepmin,stpf);
*stp = stpf;
if (mtP->bracket && bound) {
if (*sty > *stx) {
*stp = PetscMin(*stx+0.66*(*sty-*stx),*stp);
} else {
*stp = PetscMax(*stx+0.66*(*sty-*stx),*stp);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode ResidualJacobian(SNES snes,Vec X,Mat J,Mat B,void *ctx)
{
PetscErrorCode ierr;
Userctx *user=(Userctx*)ctx;
Vec Xgen,Xnet;
PetscScalar *xgen,*xnet;
PetscInt i,idx=0;
PetscScalar Vr,Vi,Vm,Vm2;
PetscScalar Eqp,Edp,delta; /* Generator variables */
PetscScalar Efd; /* Exciter variables */
PetscScalar Id,Iq; /* Generator dq axis currents */
PetscScalar Vd,Vq;
PetscScalar val[10];
PetscInt row[2],col[10];
PetscInt net_start=user->neqs_gen;
PetscScalar Zdq_inv[4],det;
PetscScalar dVd_dVr,dVd_dVi,dVq_dVr,dVq_dVi,dVd_ddelta,dVq_ddelta;
PetscScalar dIGr_ddelta,dIGi_ddelta,dIGr_dId,dIGr_dIq,dIGi_dId,dIGi_dIq;
PetscScalar dSE_dEfd;
PetscScalar dVm_dVd,dVm_dVq,dVm_dVr,dVm_dVi;
PetscInt ncols;
const PetscInt *cols;
const PetscScalar *yvals;
PetscInt k;
PetscScalar PD,QD,Vm0,*v0,Vm4;
PetscScalar dPD_dVr,dPD_dVi,dQD_dVr,dQD_dVi;
PetscScalar dIDr_dVr,dIDr_dVi,dIDi_dVr,dIDi_dVi;
PetscFunctionBegin;
ierr = MatZeroEntries(B);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
/* Generator subsystem */
for (i=0; i < ngen; i++) {
Eqp = xgen[idx];
Edp = xgen[idx+1];
delta = xgen[idx+2];
Id = xgen[idx+4];
Iq = xgen[idx+5];
Efd = xgen[idx+6];
/* fgen[idx] = (Eqp + (Xd[i] - Xdp[i])*Id - Efd)/Td0p[i]; */
row[0] = idx;
col[0] = idx; col[1] = idx+4; col[2] = idx+6;
val[0] = 1/ Td0p[i]; val[1] = (Xd[i] - Xdp[i])/ Td0p[i]; val[2] = -1/Td0p[i];
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+1] = (Edp - (Xq[i] - Xqp[i])*Iq)/Tq0p[i]; */
row[0] = idx + 1;
col[0] = idx + 1; col[1] = idx+5;
val[0] = 1/Tq0p[i]; val[1] = -(Xq[i] - Xqp[i])/Tq0p[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+2] = - w + w_s; */
row[0] = idx + 2;
col[0] = idx + 2; col[1] = idx + 3;
val[0] = 0; val[1] = -1;
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+3] = (-TM[i] + Edp*Id + Eqp*Iq + (Xqp[i] - Xdp[i])*Id*Iq + D[i]*(w - w_s))/M[i]; */
row[0] = idx + 3;
col[0] = idx; col[1] = idx + 1; col[2] = idx + 3; col[3] = idx + 4; col[4] = idx + 5;
val[0] = Iq/M[i]; val[1] = Id/M[i]; val[2] = D[i]/M[i]; val[3] = (Edp + (Xqp[i]-Xdp[i])*Iq)/M[i]; val[4] = (Eqp + (Xqp[i] - Xdp[i])*Id)/M[i];
ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr);
Vr = xnet[2*gbus[i]]; /* Real part of generator terminal voltage */
Vi = xnet[2*gbus[i]+1]; /* Imaginary part of the generator terminal voltage */
ierr = ri2dq(Vr,Vi,delta,&Vd,&Vq);CHKERRQ(ierr);
det = Rs[i]*Rs[i] + Xdp[i]*Xqp[i];
Zdq_inv[0] = Rs[i]/det;
Zdq_inv[1] = Xqp[i]/det;
Zdq_inv[2] = -Xdp[i]/det;
Zdq_inv[3] = Rs[i]/det;
dVd_dVr = PetscSinScalar(delta); dVd_dVi = -PetscCosScalar(delta);
dVq_dVr = PetscCosScalar(delta); dVq_dVi = PetscSinScalar(delta);
dVd_ddelta = Vr*PetscCosScalar(delta) + Vi*PetscSinScalar(delta);
dVq_ddelta = -Vr*PetscSinScalar(delta) + Vi*PetscCosScalar(delta);
/* fgen[idx+4] = Zdq_inv[0]*(-Edp + Vd) + Zdq_inv[1]*(-Eqp + Vq) + Id; */
row[0] = idx+4;
col[0] = idx; col[1] = idx+1; col[2] = idx + 2;
val[0] = -Zdq_inv[1]; val[1] = -Zdq_inv[0]; val[2] = Zdq_inv[0]*dVd_ddelta + Zdq_inv[1]*dVq_ddelta;
col[3] = idx + 4; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1;
val[3] = 1; val[4] = Zdq_inv[0]*dVd_dVr + Zdq_inv[1]*dVq_dVr; val[5] = Zdq_inv[0]*dVd_dVi + Zdq_inv[1]*dVq_dVi;
ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+5] = Zdq_inv[2]*(-Edp + Vd) + Zdq_inv[3]*(-Eqp + Vq) + Iq; */
row[0] = idx+5;
col[0] = idx; col[1] = idx+1; col[2] = idx + 2;
val[0] = -Zdq_inv[3]; val[1] = -Zdq_inv[2]; val[2] = Zdq_inv[2]*dVd_ddelta + Zdq_inv[3]*dVq_ddelta;
col[3] = idx + 5; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1;
val[3] = 1; val[4] = Zdq_inv[2]*dVd_dVr + Zdq_inv[3]*dVq_dVr; val[5] = Zdq_inv[2]*dVd_dVi + Zdq_inv[3]*dVq_dVi;
ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr);
dIGr_ddelta = Id*PetscCosScalar(delta) - Iq*PetscSinScalar(delta);
dIGi_ddelta = Id*PetscSinScalar(delta) + Iq*PetscCosScalar(delta);
dIGr_dId = PetscSinScalar(delta); dIGr_dIq = PetscCosScalar(delta);
dIGi_dId = -PetscCosScalar(delta); dIGi_dIq = PetscSinScalar(delta);
/* fnet[2*gbus[i]] -= IGi; */
row[0] = net_start + 2*gbus[i];
col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5;
val[0] = -dIGi_ddelta; val[1] = -dIGi_dId; val[2] = -dIGi_dIq;
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fnet[2*gbus[i]+1] -= IGr; */
row[0] = net_start + 2*gbus[i]+1;
col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5;
val[0] = -dIGr_ddelta; val[1] = -dIGr_dId; val[2] = -dIGr_dIq;
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
Vm = PetscSqrtScalar(Vd*Vd + Vq*Vq); Vm2 = Vm*Vm;
/* fgen[idx+6] = (KE[i]*Efd + SE - VR)/TE[i]; */
/* SE = k1[i]*PetscExpScalar(k2[i]*Efd); */
dSE_dEfd = k1[i]*k2[i]*PetscExpScalar(k2[i]*Efd);
row[0] = idx + 6;
col[0] = idx + 6; col[1] = idx + 8;
val[0] = (KE[i] + dSE_dEfd)/TE[i]; val[1] = -1/TE[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* Exciter differential equations */
/* fgen[idx+7] = (RF - KF[i]*Efd/TF[i])/TF[i]; */
row[0] = idx + 7;
col[0] = idx + 6; col[1] = idx + 7;
val[0] = (-KF[i]/TF[i])/TF[i]; val[1] = 1/TF[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+8] = (VR - KA[i]*RF + KA[i]*KF[i]*Efd/TF[i] - KA[i]*(Vref[i] - Vm))/TA[i]; */
/* Vm = (Vd^2 + Vq^2)^0.5; */
dVm_dVd = Vd/Vm; dVm_dVq = Vq/Vm;
dVm_dVr = dVm_dVd*dVd_dVr + dVm_dVq*dVq_dVr;
dVm_dVi = dVm_dVd*dVd_dVi + dVm_dVq*dVq_dVi;
row[0] = idx + 8;
col[0] = idx + 6; col[1] = idx + 7; col[2] = idx + 8;
val[0] = (KA[i]*KF[i]/TF[i])/TA[i]; val[1] = -KA[i]/TA[i]; val[2] = 1/TA[i];
col[3] = net_start + 2*gbus[i]; col[4] = net_start + 2*gbus[i]+1;
val[3] = KA[i]*dVm_dVr/TA[i]; val[4] = KA[i]*dVm_dVi/TA[i];
ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr);
idx = idx + 9;
}
for (i=0; i<nbus; i++) {
ierr = MatGetRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr);
row[0] = net_start + 2*i;
for (k=0; k<ncols; k++) {
col[k] = net_start + cols[k];
val[k] = yvals[k];
}
ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr);
ierr = MatGetRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr);
row[0] = net_start + 2*i+1;
for (k=0; k<ncols; k++) {
col[k] = net_start + cols[k];
val[k] = yvals[k];
}
ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
ierr = VecGetArray(user->V0,&v0);CHKERRQ(ierr);
for (i=0; i < nload; i++) {
Vr = xnet[2*lbus[i]]; /* Real part of load bus voltage */
Vi = xnet[2*lbus[i]+1]; /* Imaginary part of the load bus voltage */
Vm = PetscSqrtScalar(Vr*Vr + Vi*Vi); Vm2 = Vm*Vm; Vm4 = Vm2*Vm2;
Vm0 = PetscSqrtScalar(v0[2*lbus[i]]*v0[2*lbus[i]] + v0[2*lbus[i]+1]*v0[2*lbus[i]+1]);
PD = QD = 0.0;
dPD_dVr = dPD_dVi = dQD_dVr = dQD_dVi = 0.0;
for (k=0; k < ld_nsegsp[i]; k++) {
PD += ld_alphap[k]*PD0[i]*PetscPowScalar((Vm/Vm0),ld_betap[k]);
dPD_dVr += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vr*PetscPowScalar(Vm,(ld_betap[k]-2));
dPD_dVi += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vi*PetscPowScalar(Vm,(ld_betap[k]-2));
}
for (k=0; k < ld_nsegsq[i]; k++) {
QD += ld_alphaq[k]*QD0[i]*PetscPowScalar((Vm/Vm0),ld_betaq[k]);
dQD_dVr += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vr*PetscPowScalar(Vm,(ld_betaq[k]-2));
dQD_dVi += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vi*PetscPowScalar(Vm,(ld_betaq[k]-2));
}
/* IDr = (PD*Vr + QD*Vi)/Vm2; */
/* IDi = (-QD*Vr + PD*Vi)/Vm2; */
dIDr_dVr = (dPD_dVr*Vr + dQD_dVr*Vi + PD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vr)/Vm4;
dIDr_dVi = (dPD_dVi*Vr + dQD_dVi*Vi + QD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vi)/Vm4;
dIDi_dVr = (-dQD_dVr*Vr + dPD_dVr*Vi - QD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vr)/Vm4;
dIDi_dVi = (-dQD_dVi*Vr + dPD_dVi*Vi + PD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vi)/Vm4;
/* fnet[2*lbus[i]] += IDi; */
row[0] = net_start + 2*lbus[i];
col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1;
val[0] = dIDi_dVr; val[1] = dIDi_dVi;
ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr);
/* fnet[2*lbus[i]+1] += IDr; */
row[0] = net_start + 2*lbus[i]+1;
col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1;
val[0] = dIDr_dVr; val[1] = dIDr_dVi;
ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArray(user->V0,&v0);CHKERRQ(ierr);
ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
