PETSC_EXTERN void PETSC_STDCALL snesngsgettolerances_(SNES snes,PetscReal *atol,PetscReal *rtol,PetscReal *stol,PetscInt *maxit, int *__ierr ){
*__ierr = SNESNGSGetTolerances(
(SNES)PetscToPointer((snes) ),atol,rtol,stol,maxit);
}
PetscErrorCode NonlinearGS(SNES snes, Vec X, Vec B, void *ctx)
{
DMDALocalInfo info;
Field **x,**b;
PetscErrorCode ierr;
Vec localX, localB;
DM da;
PetscInt xints,xinte,yints,yinte,i,j,k,l;
PetscInt max_its,tot_its;
PetscInt sweeps;
PetscReal rtol,atol,stol;
PetscReal hx,hy,dhx,dhy,hxdhy,hydhx;
PetscReal grashof,prandtl,lid;
PetscScalar u,uxx,uyy,vx,vy,avx,avy,vxp,vxm,vyp,vym;
PetscScalar fu, fv, fomega, ftemp;
PetscScalar dfudu;
PetscScalar dfvdv;
PetscScalar dfodu, dfodv, dfodo;
PetscScalar dftdu, dftdv, dftdt;
PetscScalar yu=0, yv=0, yo=0, yt=0;
PetscScalar bjiu, bjiv, bjiomega, bjitemp;
PetscBool ptconverged;
PetscReal pfnorm,pfnorm0,pynorm,pxnorm;
AppCtx *user = (AppCtx*)ctx;
PetscFunctionBeginUser;
grashof = user->grashof;
prandtl = user->prandtl;
lid = user->lidvelocity;
tot_its = 0;
ierr = SNESNGSGetTolerances(snes,&rtol,&atol,&stol,&max_its);CHKERRQ(ierr);
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESGetDM(snes,(DM*)&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecGetArrayRead(da,localB,&b);CHKERRQ(ierr);
}
/* looks like a combination of the formfunction / formjacobian routines */
dhx = (PetscReal)(info.mx-1);dhy = (PetscReal)(info.my-1);
hx = 1.0/dhx; hy = 1.0/dhy;
hxdhy = hx*dhy; hydhx = hy*dhx;
xints = info.xs; xinte = info.xs+info.xm; yints = info.ys; yinte = info.ys+info.ym;
/* Set the boundary conditions on the momentum equations */
/* Test whether we are on the bottom edge of the global array */
if (yints == 0) {
j = 0;
yints = yints + 1;
/* bottom edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the top edge of the global array */
if (yinte == info.my) {
j = info.my - 1;
yinte = yinte - 1;
/* top edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = lid + bjiu;
x[j][i].v = bjiv;
}
}
/* Test whether we are on the left edge of the global array */
if (xints == 0) {
i = 0;
xints = xints + 1;
/* left edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the right edge of the global array */
if (xinte == info.mx) {
i = info.mx - 1;
xinte = xinte - 1;
/* right edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
for (k=0; k < sweeps; k++) {
for (j=info.ys; j<info.ys + info.ym; j++) {
for (i=info.xs; i<info.xs + info.xm; i++) {
ptconverged = PETSC_FALSE;
pfnorm0 = 0.0;
pfnorm = 0.0;
fu = 0.0;
fv = 0.0;
fomega = 0.0;
ftemp = 0.0;
for (l = 0; l < max_its && !ptconverged; l++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
bjiomega = b[j][i].omega;
bjitemp = b[j][i].temp;
} else {
bjiu = 0.0;
bjiv = 0.0;
bjiomega = 0.0;
bjitemp = 0.0;
}
if (i != 0 && i != info.mx - 1 && j != 0 && j != info.my-1) {
/* U velocity */
u = x[j][i].u;
uxx = (2.0*u - x[j][i-1].u - x[j][i+1].u)*hydhx;
uyy = (2.0*u - x[j-1][i].u - x[j+1][i].u)*hxdhy;
fu = uxx + uyy - .5*(x[j+1][i].omega-x[j-1][i].omega)*hx - bjiu;
dfudu = 2.0*(hydhx + hxdhy);
/* V velocity */
u = x[j][i].v;
uxx = (2.0*u - x[j][i-1].v - x[j][i+1].v)*hydhx;
uyy = (2.0*u - x[j-1][i].v - x[j+1][i].v)*hxdhy;
fv = uxx + uyy + .5*(x[j][i+1].omega-x[j][i-1].omega)*hy - bjiv;
dfvdv = 2.0*(hydhx + hxdhy);
/*
convective coefficients for upwinding
*/
vx = x[j][i].u; avx = PetscAbsScalar(vx);
vxp = .5*(vx+avx); vxm = .5*(vx-avx);
vy = x[j][i].v; avy = PetscAbsScalar(vy);
vyp = .5*(vy+avy); vym = .5*(vy-avy);
/* Omega */
u = x[j][i].omega;
uxx = (2.0*u - x[j][i-1].omega - x[j][i+1].omega)*hydhx;
uyy = (2.0*u - x[j-1][i].omega - x[j+1][i].omega)*hxdhy;
fomega = uxx + uyy + (vxp*(u - x[j][i-1].omega) + vxm*(x[j][i+1].omega - u))*hy +
(vyp*(u - x[j-1][i].omega) + vym*(x[j+1][i].omega - u))*hx -
.5*grashof*(x[j][i+1].temp - x[j][i-1].temp)*hy - bjiomega;
/* convective coefficient derivatives */
dfodo = 2.0*(hydhx + hxdhy) + ((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dfodu = (u - x[j][i-1].omega)*hy;
else dfodu = (x[j][i+1].omega - u)*hy;
if (PetscRealPart(vy) > 0.0) dfodv = (u - x[j-1][i].omega)*hx;
else dfodv = (x[j+1][i].omega - u)*hx;
/* Temperature */
u = x[j][i].temp;
uxx = (2.0*u - x[j][i-1].temp - x[j][i+1].temp)*hydhx;
uyy = (2.0*u - x[j-1][i].temp - x[j+1][i].temp)*hxdhy;
ftemp = uxx + uyy + prandtl*((vxp*(u - x[j][i-1].temp) + vxm*(x[j][i+1].temp - u))*hy +
(vyp*(u - x[j-1][i].temp) + vym*(x[j+1][i].temp - u))*hx) - bjitemp;
dftdt = 2.0*(hydhx + hxdhy) + prandtl*((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dftdu = prandtl*(u - x[j][i-1].temp)*hy;
else dftdu = prandtl*(x[j][i+1].temp - u)*hy;
if (PetscRealPart(vy) > 0.0) dftdv = prandtl*(u - x[j-1][i].temp)*hx;
else dftdv = prandtl*(x[j+1][i].temp - u)*hx;
/* invert the system:
[ dfu / du 0 0 0 ][yu] = [fu]
[ 0 dfv / dv 0 0 ][yv] [fv]
[ dfo / du dfo / dv dfo / do 0 ][yo] [fo]
[ dft / du dft / dv 0 dft / dt ][yt] [ft]
by simple back-substitution
*/
yu = fu / dfudu;
yv = fv / dfvdv;
yo = fomega / dfodo;
yt = ftemp / dftdt;
yo = (fomega - (dfodu*yu + dfodv*yv)) / dfodo;
yt = (ftemp - (dftdu*yu + dftdv*yv)) / dftdt;
x[j][i].u = x[j][i].u - yu;
x[j][i].v = x[j][i].v - yv;
x[j][i].temp = x[j][i].temp - yt;
x[j][i].omega = x[j][i].omega - yo;
}
if (i == 0) {
fomega = x[j][i].omega - (x[j][i+1].v - x[j][i].v)*dhx - bjiomega;
ftemp = x[j][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (i == info.mx - 1) {
fomega = x[j][i].omega - (x[j][i].v - x[j][i-1].v)*dhx - bjiomega;
ftemp = x[j][i].temp - (PetscReal)(grashof>0) - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == 0) {
fomega = x[j][i].omega + (x[j+1][i].u - x[j][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j+1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == info.my - 1) {
fomega = x[j][i].omega + (x[j][i].u - x[j-1][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j-1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
tot_its++;
pfnorm = PetscRealPart(fu*fu + fv*fv + fomega*fomega + ftemp*ftemp);
pfnorm = PetscSqrtReal(pfnorm);
pynorm = PetscRealPart(yu*yu + yv*yv + yo*yo + yt*yt);
pfnorm = PetscSqrtReal(pynorm);
pxnorm = PetscRealPart(x[j][i].u*x[j][i].u + x[j][i].v*x[j][i].v + x[j][i].omega*x[j][i].omega + x[j][i].temp*x[j][i].temp);
pxnorm = PetscSqrtReal(pxnorm);
if (l == 0) pfnorm0 = pfnorm;
if (rtol*pfnorm0 > pfnorm ||
atol > pfnorm ||
pxnorm*stol > pynorm) ptconverged = PETSC_TRUE;
}
}
}
}
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArrayRead(da,localB,&b);CHKERRQ(ierr);
}
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = PetscLogFlops(tot_its*(84.0 + 41.0 + 26.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode NonlinearGS(SNES snes,Vec X,Vec B,void *ptr)
{
/* values for each basis function at each quadrature point */
AppCtx *user = (AppCtx*)ptr;
PetscInt i,j,k,l,m,n,s;
PetscInt pi,pj,pk;
Field ef[1];
Field ex[8];
PetscScalar ej[9];
CoordField ec[8];
PetscScalar pjac[9],pjinv[9];
PetscScalar pf[3],py[3];
PetscErrorCode ierr;
PetscInt xs,ys,zs;
PetscInt xm,ym,zm;
PetscInt mx,my,mz;
DM cda;
CoordField ***c;
Vec C;
DM da;
Vec Xl,Bl;
Field ***x,***b;
PetscInt sweeps,its;
PetscReal atol,rtol,stol;
PetscReal fnorm0 = 0.0,fnorm,ynorm,xnorm = 0.0;
PetscFunctionBegin;
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&Xl);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&Bl);CHKERRQ(ierr);
}
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xl);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xl);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,Bl);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,Bl);CHKERRQ(ierr);
}
ierr = DMDAVecGetArray(da,Xl,&x);CHKERRQ(ierr);
if (B) ierr = DMDAVecGetArray(da,Bl,&b);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(da,&C);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,C,&c);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&mx,&my,&mz,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
for (s=0;s<sweeps;s++) {
for (k=zs; k<zs+zm; k++) {
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (OnBoundary(i,j,k,mx,my,mz)) {
BoundaryValue(i,j,k,mx,my,mz,x[k][j][i],user);
} else {
for (n=0;n<its;n++) {
for (m=0;m<9;m++) pjac[m] = 0.;
for (m=0;m<3;m++) pf[m] = 0.;
/* gather the elements for this point */
for (pk=-1; pk<1; pk++) {
for (pj=-1; pj<1; pj++) {
for (pi=-1; pi<1; pi++) {
/* check that this element exists */
if (i+pi >= 0 && i+pi < mx-1 && j+pj >= 0 && j+pj < my-1 && k+pk >= 0 && k+pk < mz-1) {
/* create the element function and jacobian */
GatherElementData(mx,my,mz,x,c,i+pi,j+pj,k+pk,ex,ec,user);
FormPBJacobian(-pi,-pj,-pk,ex,ec,ef,ej,user);
/* extract the point named by i,j,k from the whole element jacobian and function */
for (l=0;l<3;l++) {
pf[l] += ef[0][l];
for (m=0;m<3;m++) {
pjac[3*m+l] += ej[3*m+l];
}
}
}
}
}
}
/* invert */
InvertTensor(pjac,pjinv,NULL);
/* apply */
if (B) for (m=0;m<3;m++) {
pf[m] -= b[k][j][i][m];
}
TensorVector(pjinv,pf,py);
xnorm=0.;
for (m=0;m<3;m++) {
x[k][j][i][m] -= py[m];
xnorm += PetscRealPart(x[k][j][i][m]*x[k][j][i][m]);
}
fnorm = PetscRealPart(pf[0]*pf[0]+pf[1]*pf[1]+pf[2]*pf[2]);
if (n==0) fnorm0 = fnorm;
ynorm = PetscRealPart(py[0]*py[0]+py[1]*py[1]+py[2]*py[2]);
if (fnorm < atol*atol || fnorm < rtol*rtol*fnorm0 || ynorm < stol*stol*xnorm) break;
}
}
}
}
}
}
ierr = DMDAVecRestoreArray(da,Xl,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,Xl,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,Xl,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Xl);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,Bl,&b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Bl);CHKERRQ(ierr);
}
ierr = DMDAVecRestoreArray(cda,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Applies some sweeps on nonlinear Gauss-Seidel on each process
*/
PetscErrorCode NonlinearGS(SNES snes,Vec X, Vec B, void *ctx)
{
PetscInt i,j,k,Mx,My,xs,ys,xm,ym,its,tot_its,sweeps,l;
PetscErrorCode ierr;
PetscReal lambda,hx,hy,hxdhy,hydhx,sc;
PetscScalar **x,**b,bij,F,F0=0,J,u,un,us,ue,eu,uw,uxx,uyy,y;
PetscReal atol,rtol,stol;
DM da;
AppCtx *user;
Vec localX,localB;
PetscFunctionBeginUser;
tot_its = 0;
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetApplicationContext(da,(void**)&user);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
lambda = user->param;
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
sc = hx*hy*lambda;
hxdhy = hx/hy;
hydhx = hy/hx;
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
for (l=0; l<sweeps; l++) {
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) ierr = DMDAVecGetArray(da,localB,&b);CHKERRQ(ierr);
/*
Get local grid boundaries (for 2-dimensional DMDA):
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
/* boundary conditions are all zero Dirichlet */
x[j][i] = 0.0;
} else {
if (B) bij = b[j][i];
else bij = 0.;
u = x[j][i];
un = x[j-1][i];
us = x[j+1][i];
ue = x[j][i-1];
uw = x[j][i+1];
for (k=0; k<its; k++) {
eu = PetscExpScalar(u);
uxx = (2.0*u - ue - uw)*hydhx;
uyy = (2.0*u - un - us)*hxdhy;
F = uxx + uyy - sc*eu - bij;
if (k == 0) F0 = F;
J = 2.0*(hydhx + hxdhy) - sc*eu;
y = F/J;
u -= y;
tot_its++;
if (atol > PetscAbsReal(PetscRealPart(F)) ||
rtol*PetscAbsReal(PetscRealPart(F0)) > PetscAbsReal(PetscRealPart(F)) ||
stol*PetscAbsReal(PetscRealPart(u)) > PetscAbsReal(PetscRealPart(y))) {
break;
}
}
x[j][i] = u;
}
}
}
/*
Restore vector
*/
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
}
ierr = PetscLogFlops(tot_its*(21.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,localB,&b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode SNESComputeNGSDefaultSecant(SNES snes,Vec X,Vec B,void *ctx)
{
PetscErrorCode ierr;
SNES_NGS *gs = (SNES_NGS*)snes->data;
PetscInt i,j,k,ncolors;
DM dm;
PetscBool flg;
ISColoring coloring = gs->coloring;
MatColoring mc;
Vec W,G,F;
PetscScalar h=gs->h;
IS *coloris;
PetscScalar f,g,x,w,d;
PetscReal dxt,xt,ft,ft1=0;
const PetscInt *idx;
PetscInt size,s;
PetscReal atol,rtol,stol;
PetscInt its;
PetscErrorCode (*func)(SNES,Vec,Vec,void*);
void *fctx;
PetscBool mat = gs->secant_mat,equal,isdone,alldone;
PetscScalar *xa,*fa,*wa,*ga;
PetscFunctionBegin;
if (snes->nwork < 3) {
ierr = SNESSetWorkVecs(snes,3);CHKERRQ(ierr);
}
W = snes->work[0];
G = snes->work[1];
F = snes->work[2];
ierr = VecGetOwnershipRange(X,&s,NULL);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = SNESGetFunction(snes,NULL,&func,&fctx);CHKERRQ(ierr);
if (!coloring) {
/* create the coloring */
ierr = DMHasColoring(dm,&flg);CHKERRQ(ierr);
if (flg && !mat) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&coloring);CHKERRQ(ierr);
} else {
if (!snes->jacobian) {ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);}
ierr = MatColoringCreate(snes->jacobian,&mc);CHKERRQ(ierr);
ierr = MatColoringSetDistance(mc,1);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&coloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
}
gs->coloring = coloring;
}
ierr = ISColoringGetIS(coloring,&ncolors,&coloris);CHKERRQ(ierr);
ierr = VecEqual(X,snes->vec_sol,&equal);CHKERRQ(ierr);
if (equal && snes->normschedule == SNES_NORM_ALWAYS) {
/* assume that the function is already computed */
ierr = VecCopy(snes->vec_func,F);CHKERRQ(ierr);
} else {
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);}
}
ierr = VecGetArray(X,&xa);CHKERRQ(ierr);
ierr = VecGetArray(F,&fa);CHKERRQ(ierr);
ierr = VecGetArray(G,&ga);CHKERRQ(ierr);
ierr = VecGetArray(W,&wa);CHKERRQ(ierr);
for (i=0;i<ncolors;i++) {
ierr = ISGetIndices(coloris[i],&idx);CHKERRQ(ierr);
ierr = ISGetLocalSize(coloris[i],&size);CHKERRQ(ierr);
ierr = VecCopy(X,W);CHKERRQ(ierr);
for (j=0;j<size;j++) {
wa[idx[j]-s] += h;
}
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,W,G,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(G,-1.0,B);CHKERRQ(ierr);}
for (k=0;k<its;k++) {
dxt = 0.;
xt = 0.;
ft = 0.;
for (j=0;j<size;j++) {
f = fa[idx[j]-s];
x = xa[idx[j]-s];
g = ga[idx[j]-s];
w = wa[idx[j]-s];
if (PetscAbsScalar(g-f) > atol) {
/* This is equivalent to d = x - (h*f) / PetscRealPart(g-f) */
d = (x*g-w*f) / PetscRealPart(g-f);
} else {
d = x;
}
dxt += PetscRealPart(PetscSqr(d-x));
xt += PetscRealPart(PetscSqr(x));
ft += PetscRealPart(PetscSqr(f));
xa[idx[j]-s] = d;
}
if (k == 0) ft1 = PetscSqrtReal(ft);
if (k<its-1) {
isdone = PETSC_FALSE;
if (stol*PetscSqrtReal(xt) > PetscSqrtReal(dxt)) isdone = PETSC_TRUE;
if (PetscSqrtReal(ft) < atol) isdone = PETSC_TRUE;
if (rtol*ft1 > PetscSqrtReal(ft)) isdone = PETSC_TRUE;
ierr = MPIU_Allreduce(&isdone,&alldone,1,MPIU_BOOL,MPI_BAND,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
if (alldone) break;
}
if (i < ncolors-1 || k < its-1) {
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);}
}
if (k<its-1) {
ierr = VecSwap(X,W);CHKERRQ(ierr);
ierr = VecSwap(F,G);CHKERRQ(ierr);
}
}
}
ierr = VecRestoreArray(X,&xa);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&fa);CHKERRQ(ierr);
ierr = VecRestoreArray(G,&ga);CHKERRQ(ierr);
ierr = VecRestoreArray(W,&wa);CHKERRQ(ierr);
ierr = ISColoringRestoreIS(coloring,&coloris);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
