/*@
MatFDColoringApply - Given a matrix for which a MatFDColoring context
has been created, computes the Jacobian for a function via finite differences.
Collective on MatFDColoring
Input Parameters:
+ mat - location to store Jacobian
. coloring - coloring context created with MatFDColoringCreate()
. x1 - location at which Jacobian is to be computed
- sctx - context required by function, if this is being used with the SNES solver then it is SNES object, otherwise it is null
Options Database Keys:
+ -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS)
. -mat_fd_coloring_view - Activates basic viewing or coloring
. -mat_fd_coloring_view draw - Activates drawing of coloring
- -mat_fd_coloring_view ::ascii_info - Activates viewing of coloring info
Level: intermediate
.seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringSetFunction()
.keywords: coloring, Jacobian, finite differences
@*/
PetscErrorCode MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,void *sctx)
{
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
PetscValidHeaderSpecific(J,MAT_CLASSID,1);
PetscValidHeaderSpecific(coloring,MAT_FDCOLORING_CLASSID,2);
PetscValidHeaderSpecific(x1,VEC_CLASSID,3);
if (!coloring->f) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");
if (!J->ops->fdcoloringapply) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not supported for this matrix type %s",((PetscObject)J)->type_name);
if (!coloring->setupcalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetUp()");
ierr = MatSetUnfactored(J);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
} else {
PetscBool assembled;
ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(J);CHKERRQ(ierr);
}
}
ierr = PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
ierr = (*J->ops->fdcoloringapply)(J,coloring,x1,sctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian - Evaluates Hessian matrix.
Input Parameters:
. tao - the Tao context
. x - input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
Note: Providing the Hessian may not be necessary. Only some solvers
require this matrix.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H, Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i, ind[2];
PetscReal alpha=user->alpha;
PetscReal v[2][2],*x;
PetscBool assembled;
/* Zero existing matrix entries */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
/* Get a pointer to vector data */
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
/* Compute H(X) entries */
for (i=0; i<user->n/2; i++){
v[1][1] = 2*alpha;
v[0][0] = -4*alpha*(x[2*i+1]-3*x[2*i]*x[2*i]) + 2;
v[1][0] = v[0][1] = -4.0*alpha*x[2*i];
ind[0]=2*i; ind[1]=2*i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
/* Assemble matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(9.0*user->n/2.0);CHKERRQ(ierr);
return 0;
}
void
PetscSparseMtrx :: zero()
{
// test if receiver is already assembled
PetscBool assembled;
MatAssembled(this->mtrx, & assembled);
if ( assembled ) {
MatZeroEntries(this->mtrx);
}
this->newValues = true;
}
bool PetscMatrix<T>::closed() const
{
libmesh_assert (this->initialized());
PetscErrorCode ierr=0;
PetscBool assembled;
ierr = MatAssembled(_mat, &assembled);
LIBMESH_CHKERRABORT(ierr);
return (assembled == PETSC_TRUE);
}
/*
FormHessian - Evaluates Hessian matrix.
Input Parameters:
. tao - the Tao context
. x - input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
Note: Providing the Hessian may not be necessary. Only some solvers
require this matrix.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H, Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i, ind[2];
PetscReal alpha=user->alpha;
PetscReal v[2][2];
const PetscScalar *x;
PetscBool assembled;
PetscFunctionBeginUser;
/* Zero existing matrix entries */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
/* Get a pointer to vector data */
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
/* Compute H(X) entries */
if (user->chained) {
ierr = MatZeroEntries(H);CHKERRQ(ierr);
for (i=0; i<user->n-1; i++) {
PetscScalar t1 = x[i+1] - x[i]*x[i];
v[0][0] = 2 + 2*alpha*(t1*(-2) - 2*x[i]);
v[0][1] = 2*alpha*(-2*x[i]);
v[1][0] = 2*alpha*(-2*x[i]);
v[1][1] = 2*alpha*t1;
ind[0] = i; ind[1] = i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],ADD_VALUES);CHKERRQ(ierr);
}
} else {
for (i=0; i<user->n/2; i++){
v[1][1] = 2*alpha;
v[0][0] = -4*alpha*(x[2*i+1]-3*x[2*i]*x[2*i]) + 2;
v[1][0] = v[0][1] = -4.0*alpha*x[2*i];
ind[0]=2*i; ind[1]=2*i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
/* Assemble matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(9.0*user->n/2.0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian - Forms the Hessian matrix.
Input Parameters:
. tao - the Tao context
. X - the input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
. PrecH - optionally different preconditioning Hessian
. flag - flag indicating matrix structure
Notes:
This routine is intended simply as an example of the interface
to a Hessian evaluation routine. Since this example compute the
Hessian a column at a time, it is not particularly efficient and
is not recommended.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H,Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx *) ptr;
PetscErrorCode ierr;
PetscInt i,j, ndim = user->ndim;
PetscReal *y, zero = 0.0, one = 1.0;
PetscBool assembled;
user->xvec = X;
/* Initialize Hessian entries and work vector to zero */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
ierr = VecSet(user->s, zero);CHKERRQ(ierr);
/* Loop over matrix columns to compute entries of the Hessian */
for (j=0; j<ndim; j++) {
ierr = VecSetValues(user->s,1,&j,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->s);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->s);CHKERRQ(ierr);
ierr = HessianProduct(ptr,user->s,user->y);CHKERRQ(ierr);
ierr = VecSetValues(user->s,1,&j,&zero,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->s);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->s);CHKERRQ(ierr);
ierr = VecGetArray(user->y,&y);CHKERRQ(ierr);
for (i=0; i<ndim; i++) {
if (y[i] != zero) {
ierr = MatSetValues(H,1,&i,1,&j,&y[i],ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(user->y,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
return 0;
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. snes - SNES context
. X - input vector
. ptr - optional user-defined context, as set by SNESSetJacobian()
Output Parameters:
. tH - Jacobian matrix
*/
PetscErrorCode FormJacobian(SNES snes, Vec X, Mat *tH, Mat *tHPre, MatStructure *flag, void *ptr)
{
AppCtx *user = (AppCtx*) ptr;
Mat H = *tH;
PetscErrorCode ierr;
PetscInt i,j,k;
PetscInt mx=user->mx, my=user->my;
MatStencil row,col[7];
PetscScalar hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
PetscScalar f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscScalar hl,hr,ht,hb,hc,htl,hbr;
PetscScalar **x, v[7];
PetscBool assembled;
PetscInt xs,xm,ys,ym;
Vec localX;
PetscScalar *top,*bottom,*left,*right;
PetscFunctionBeginUser;
/* Set various matrix options */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled) {ierr = MatZeroEntries(H);CHKERRQ(ierr);}
*flag=SAME_NONZERO_PATTERN;
/* Get local vectors */
ierr = DMGetLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = VecGetArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecGetArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecGetArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecGetArray(user->Right,&right);CHKERRQ(ierr);
/* Get ghost points */
ierr = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(user->da,localX, &x);CHKERRQ(ierr);
ierr = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute Jacobian over the locally owned part of the mesh */
for (j=ys; j< ys+ym; j++) {
for (i=xs; i< xs+xm; i++) {
xc = x[j][i];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left */
if (i==0) {
xl = left[j+1];
xlt = left[j+2];
} else xl = x[j][i-1];
/* Bottom */
if (j==0) {
xb = bottom[i+1];
xrb = bottom[i+2];
} else xb = x[j-1][i];
/* Right */
if (i+1 == mx) {
xr = right[j+1];
xrb = right[j];
} else xr = x[j][i+1];
/* Top */
if (j+1==my) {
xt = top[i+1];
xlt = top[i];
} else xt = x[j+1][i];
/* Top left */
if (i>0 && j+1<my) xlt = x[j+1][i-1];
/* Bottom right */
if (j>0 && i+1<mx) xrb = x[j-1][i+1];
d1 = (xc-xl)/hx;
d2 = (xc-xr)/hx;
d3 = (xc-xt)/hy;
d4 = (xc-xb)/hy;
d5 = (xrb-xr)/hy;
d6 = (xrb-xb)/hx;
d7 = (xlt-xl)/hy;
d8 = (xlt-xt)/hx;
f1 = PetscSqrtReal(1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtReal(1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtReal(1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtReal(1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtReal(1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtReal(1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+
(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+
(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+
(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+
(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) +
hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) +
(hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl/=2.0; hr/=2.0; ht/=2.0; hb/=2.0; hbr/=2.0; htl/=2.0; hc/=2.0;
k = 0;
row.i = i;row.j = j;
/* Bottom */
if (j>0) {
v[k] = hb;
col[k].i = i; col[k].j=j-1; k++;
}
/* Bottom right */
if (j>0 && i < mx -1) {
v[k] = hbr;
col[k].i = i+1; col[k].j = j-1; k++;
}
/* left */
if (i>0) {
v[k] = hl;
col[k].i = i-1; col[k].j = j; k++;
}
/* Centre */
v[k]= hc; col[k].i= row.i; col[k].j = row.j; k++;
/* Right */
if (i < mx-1) {
v[k] = hr;
col[k].i= i+1; col[k].j = j;k++;
}
/* Top left */
if (i>0 && j < my-1) {
v[k] = htl;
col[k].i = i-1;col[k].j = j+1; k++;
}
/* Top */
if (j < my-1) {
v[k] = ht;
col[k].i = i; col[k].j = j+1; k++;
}
ierr = MatSetValuesStencil(H,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Right,&right);CHKERRQ(ierr);
/* Assemble the matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,localX,&x);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops(199*mx*my);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian computes the quadratic term in the quadratic objective function
Notice that the objective function in this problem is quadratic (therefore a constant
hessian). If using a nonquadratic solver, then you might want to reconsider this function
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat hes, Mat Hpre, void *ptr)
{
AppCtx* user=(AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i,j,k;
PetscInt col[5],row,nx,ny,xs,xm,gxs,gxm,ys,ym,gys,gym;
PetscReal one=1.0, two=2.0, six=6.0,pi=4.0*atan(1.0);
PetscReal hx,hy,hxhy,hxhx,hyhy;
PetscReal xi,v[5];
PetscReal ecc=user->ecc, trule1,trule2,trule3,trule4,trule5,trule6;
PetscReal vmiddle, vup, vdown, vleft, vright;
PetscBool assembled;
nx=user->nx;
ny=user->ny;
hx=two*pi/(nx+1.0);
hy=two*user->b/(ny+1.0);
hxhy=hx*hy;
hxhx=one/(hx*hx);
hyhy=one/(hy*hy);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(user->dm,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
ierr = DMDAGetGhostCorners(user->dm,&gxs,&gys,NULL,&gxm,&gym,NULL);CHKERRQ(ierr);
ierr = MatAssembled(hes,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(hes);CHKERRQ(ierr);}
for (i=xs; i< xs+xm; i++){
xi=(i+1)*hx;
trule1=hxhy*( p(xi,ecc) + p(xi+hx,ecc) + p(xi,ecc) ) / six; /* L(i,j) */
trule2=hxhy*( p(xi,ecc) + p(xi-hx,ecc) + p(xi,ecc) ) / six; /* U(i,j) */
trule3=hxhy*( p(xi,ecc) + p(xi+hx,ecc) + p(xi+hx,ecc) ) / six; /* U(i+1,j) */
trule4=hxhy*( p(xi,ecc) + p(xi-hx,ecc) + p(xi-hx,ecc) ) / six; /* L(i-1,j) */
trule5=trule1; /* L(i,j-1) */
trule6=trule2; /* U(i,j+1) */
vdown=-(trule5+trule2)*hyhy;
vleft=-hxhx*(trule2+trule4);
vright= -hxhx*(trule1+trule3);
vup=-hyhy*(trule1+trule6);
vmiddle=(hxhx)*(trule1+trule2+trule3+trule4)+hyhy*(trule1+trule2+trule5+trule6);
v[0]=0; v[1]=0; v[2]=0; v[3]=0; v[4]=0;
for (j=ys; j<ys+ym; j++){
row=(j-gys)*gxm + (i-gxs);
k=0;
if (j>gys){
v[k]=vdown; col[k]=row - gxm; k++;
}
if (i>gxs){
v[k]= vleft; col[k]=row - 1; k++;
}
v[k]= vmiddle; col[k]=row; k++;
if (i+1 < gxs+gxm){
v[k]= vright; col[k]=row+1; k++;
}
if (j+1 <gys+gym){
v[k]= vup; col[k] = row+gxm; k++;
}
ierr = MatSetValuesLocal(hes,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = MatAssemblyBegin(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Tell the matrix we will never add a new nonzero location to the
matrix. If we do it will generate an error.
*/
ierr = MatSetOption(hes,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(hes,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscLogFlops(9*xm*ym+49*xm);CHKERRQ(ierr);
ierr = MatNorm(hes,NORM_1,&hx);CHKERRQ(ierr);
return 0;
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,*xx,wscale;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscErrorCode (*eval_fct)(SNES,Vec,Vec)=0;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
eval_fct = SNESComputeFunction;
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
}
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = 1.0 + unorm;
else dx = xx[i-start];
ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
QuadraticH - Evaluates Hessian matrix.
Input Parameters:
. user - user-defined context, as set by TaoSetHessian()
. X - input vector
Output Parameter:
. H - Hessian matrix
*/
int QuadraticH(AppCtx *user, Vec X, Mat Hessian)
{
int info;
PetscInt i,j,k;
PetscInt mx=user->mx, my=user->my;
PetscInt xs,xm,gxs,gxm,ys,ym,gys,gym;
double hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
double f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
double hl,hr,ht,hb,hc,htl,hbr;
PetscScalar **x, v[7];
MatStencil col[7],row;
Vec localX;
PetscTruth assembled;
/* Get local mesh boundaries */
info = DAGetLocalVector(user->da,&localX);CHKERRQ(info);
info = DAGetCorners(user->da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL); CHKERRQ(info);
info = DAGetGhostCorners(user->da,&gxs,&gys,PETSC_NULL,&gxm,&gym,PETSC_NULL); CHKERRQ(info);
/* Scatter ghost points to local vector */
info = DAGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX); CHKERRQ(info);
info = DAGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX); CHKERRQ(info);
/* Get pointers to vector data */
info = DAVecGetArray(user->da,localX,(void**)&x);
/* Initialize matrix entries to zero */
info = MatAssembled(Hessian,&assembled); CHKERRQ(info);
if (assembled){info = MatZeroEntries(Hessian); CHKERRQ(info);}
/* Set various matrix options */
info = MatSetOption(Hessian,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE); CHKERRQ(info);
/* Compute Hessian over the locally owned part of the mesh */
for (j=ys; j<ys+ym; j++){
for (i=xs; i< xs+xm; i++){
xc = x[j][i];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left side */
if (i==0){
xl = user->left[j-ys+1];
xlt = user->left[j-ys+2];
} else {
xl = x[j][i-1];
}
if (j==0){
xb = user->bottom[i-xs+1];
xrb = user->bottom[i-xs+2];
} else {
xb = x[j-1][i];
}
if (i+1 == mx){
xr = user->right[j-ys+1];
xrb = user->right[j-ys];
} else {
xr = x[j][i+1];
}
if (j+1==my){
xt = user->top[i-xs+1];
xlt = user->top[i-xs];
}else {
xt = x[j+1][i];
}
if (i>0 && j+1<my){
xlt = x[j+1][i-1];
}
if (j>0 && i+1<mx){
xrb = x[j-1][i+1];
}
d1 = (xc-xl)/hx;
d2 = (xc-xr)/hx;
d3 = (xc-xt)/hy;
d4 = (xc-xb)/hy;
d5 = (xrb-xr)/hy;
d6 = (xrb-xb)/hx;
d7 = (xlt-xl)/hy;
d8 = (xlt-xt)/hx;
f1 = sqrt( 1.0 + d1*d1 + d7*d7);
f2 = sqrt( 1.0 + d1*d1 + d4*d4);
f3 = sqrt( 1.0 + d3*d3 + d8*d8);
f4 = sqrt( 1.0 + d3*d3 + d2*d2);
f5 = sqrt( 1.0 + d2*d2 + d5*d5);
f6 = sqrt( 1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+
(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+
(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+
(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+
(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) +
hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) +
(hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl/=2.0; hr/=2.0; ht/=2.0; hb/=2.0; hbr/=2.0; htl/=2.0; hc/=2.0;
row.j = j; row.i = i;
k=0;
if (j>0){
v[k]=hb;
col[k].j = j - 1; col[k].i = i;
k++;
}
if (j>0 && i < mx -1){
v[k]=hbr;
col[k].j = j - 1; col[k].i = i+1;
k++;
}
if (i>0){
v[k]= hl;
col[k].j = j; col[k].i = i-1;
k++;
}
v[k]= hc;
col[k].j = j; col[k].i = i;
k++;
if (i < mx-1 ){
v[k]= hr;
col[k].j = j; col[k].i = i+1;
k++;
}
if (i>0 && j < my-1 ){
v[k]= htl;
col[k].j = j+1; col[k].i = i-1;
k++;
}
if (j < my-1 ){
v[k]= ht;
col[k].j = j+1; col[k].i = i;
k++;
}
/*
Set matrix values using local numbering, which was defined
earlier, in the main routine.
*/
info = MatSetValuesStencil(Hessian,1,&row,k,col,v,INSERT_VALUES);
CHKERRQ(info);
}
}
/* Restore vectors */
info = DAVecRestoreArray(user->da,localX,(void**)&x);
info = DARestoreLocalVector(user->da,&localX); CHKERRQ(info);
/* Assemble the matrix */
info = MatAssemblyBegin(Hessian,MAT_FINAL_ASSEMBLY); CHKERRQ(info);
info = MatAssemblyEnd(Hessian,MAT_FINAL_ASSEMBLY); CHKERRQ(info);
info = PetscLogFlops(199*xm*ym); CHKERRQ(info);
return 0;
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. tao - the TAO_APPLICATION context
. X - input vector
. ptr - optional user-defined context, as set by TaoSetJacobian()
Output Parameters:
. tH - Jacobian matrix
*/
PetscErrorCode FormJacobian(Tao tao, Vec X, Mat H, Mat tHPre, void *ptr)
{
AppCtx *user = (AppCtx *) ptr;
PetscErrorCode ierr;
PetscInt i,j,k,row;
PetscInt mx=user->mx, my=user->my;
PetscInt col[7];
PetscReal hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscReal hl,hr,ht,hb,hc,htl,hbr;
PetscScalar *x, v[7];
PetscBool assembled;
/* Set various matrix options */
ierr = MatSetOption(H,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
/* Get pointers to vector data */
ierr = VecGetArray(X, &x);CHKERRQ(ierr);
/* Compute Jacobian over the locally owned part of the mesh */
for (i=0; i< mx; i++){
for (j=0; j<my; j++){
row= j*mx + i;
xc = x[row];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left side */
if (i==0){
xl= user->left[j+1];
xlt = user->left[j+2];
} else {
xl = x[row-1];
}
if (j==0){
xb=user->bottom[i+1];
xrb = user->bottom[i+2];
} else {
xb = x[row-mx];
}
if (i+1 == mx){
xr=user->right[j+1];
xrb = user->right[j];
} else {
xr = x[row+1];
}
if (j+1==my){
xt=user->top[i+1];
xlt = user->top[i];
}else {
xt = x[row+mx];
}
if (i>0 && j+1<my){
xlt = x[row-1+mx];
}
if (j>0 && i+1<mx){
xrb = x[row+1-mx];
}
d1 = (xc-xl)/hx;
d2 = (xc-xr)/hx;
d3 = (xc-xt)/hy;
d4 = (xc-xb)/hy;
d5 = (xrb-xr)/hy;
d6 = (xrb-xb)/hx;
d7 = (xlt-xl)/hy;
d8 = (xlt-xt)/hx;
f1 = PetscSqrtScalar( 1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar( 1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar( 1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar( 1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) + hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) + (hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl/=2.0; hr/=2.0; ht/=2.0; hb/=2.0; hbr/=2.0; htl/=2.0; hc/=2.0;
k=0;
if (j>0){
v[k]=hb; col[k]=row - mx; k++;
}
if (j>0 && i < mx -1){
v[k]=hbr; col[k]=row - mx+1; k++;
}
if (i>0){
v[k]= hl; col[k]=row - 1; k++;
}
v[k]= hc; col[k]=row; k++;
if (i < mx-1 ){
v[k]= hr; col[k]=row+1; k++;
}
if (i>0 && j < my-1 ){
v[k]= htl; col[k] = row+mx-1; k++;
}
if (j < my-1 ){
v[k]= ht; col[k] = row+mx; k++;
}
/*
Set matrix values using local numbering, which was defined
earlier, in the main routine.
*/
ierr = MatSetValues(H,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Restore vectors */
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
/* Assemble the matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(199*mx*my);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian computes the quadratic term in the quadratic objective function
Notice that the objective function in this problem is quadratic (therefore a constant
hessian). If using a nonquadratic solver, then you might want to reconsider this function
*/
PetscErrorCode FormHessian(SNES snes,Vec X,Mat *H, Mat *Hpre, MatStructure *flg, void *ptr)
{
AppCtx *user=(AppCtx*)ptr;
PetscErrorCode info;
PetscInt i,j,k;
MatStencil row,col[5];
PetscInt nx,ny,xs,xm,ys,ym;
PetscReal one=1.0, two=2.0, six=6.0,pi=4.0*atan(1.0);
PetscReal hx,hy,hxhy,hxhx,hyhy;
PetscReal xi,v[5];
PetscReal ecc=user->ecc, trule1,trule2,trule3,trule4,trule5,trule6;
PetscReal vmiddle, vup, vdown, vleft, vright;
Mat hes=*H;
PetscBool assembled;
PetscReal **x;
Vec localX;
PetscFunctionBeginUser;
nx = user->nx;
ny = user->ny;
hx = two*pi/(nx+1.0);
hy = two*user->b/(ny+1.0);
hxhy = hx*hy;
hxhx = one/(hx*hx);
hyhy = one/(hy*hy);
info = MatAssembled(hes,&assembled);CHKERRQ(info);
if (assembled) {info = MatZeroEntries(hes);CHKERRQ(info);}
*flg=SAME_NONZERO_PATTERN;
/* Get local vector */
info = DMGetLocalVector(user->da,&localX);CHKERRQ(info);
/* Get ghost points */
info = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
info = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(info);
/* Get pointers to vector data */
info = DMDAVecGetArray(user->da,localX, &x);CHKERRQ(info);
info = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(info);
for (i=xs; i< xs+xm; i++) {
xi = (i+1)*hx;
trule1 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi,ecc)) / six; /* L(i,j) */
trule2 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi,ecc)) / six; /* U(i,j) */
trule3 = hxhy*(p(xi,ecc) + p(xi+hx,ecc) + p(xi+hx,ecc)) / six; /* U(i+1,j) */
trule4 = hxhy*(p(xi,ecc) + p(xi-hx,ecc) + p(xi-hx,ecc)) / six; /* L(i-1,j) */
trule5 = trule1; /* L(i,j-1) */
trule6 = trule2; /* U(i,j+1) */
vdown = -(trule5+trule2)*hyhy;
vleft = -hxhx*(trule2+trule4);
vright = -hxhx*(trule1+trule3);
vup = -hyhy*(trule1+trule6);
vmiddle = (hxhx)*(trule1+trule2+trule3+trule4)+hyhy*(trule1+trule2+trule5+trule6);
v[0]=0; v[1]=0; v[2]=0; v[3]=0; v[4]=0;
for (j=ys; j<ys+ym; j++) {
k =0;
row.i = i; row.j = j;
if (j > 0) {
v[k]=vdown; col[k].i=i;col[k].j = j-1; k++;
}
if (i > 0) {
v[k]= vleft; col[k].i= i-1; col[k].j = j;k++;
}
v[k]= vmiddle; col[k].i=i; col[k].j = j;k++;
if (i+1 < nx) {
v[k]= vright; col[k].i = i+1; col[k].j = j; k++;
}
if (j+1 < ny) {
v[k]= vup; col[k].i = i; col[k].j = j+1; k++;
}
info = MatSetValuesStencil(hes,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(info);
}
}
info = MatAssemblyBegin(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(info);
info = DMDAVecRestoreArray(user->da,localX,&x);CHKERRQ(info);
info = MatAssemblyEnd(hes,MAT_FINAL_ASSEMBLY);CHKERRQ(info);
info = DMRestoreLocalVector(user->da,&localX);CHKERRQ(info);
/*
Tell the matrix we will never add a new nonzero location to the
matrix. If we do it will generate an error.
*/
info = MatSetOption(hes,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(info);
info = MatSetOption(hes,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(info);
info = PetscLogFlops(9*xm*ym+49*xm);CHKERRQ(info);
PetscFunctionReturn(0);
}
PetscErrorCode MatFDColoringApply_AIJ(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void *sctx)
{
PetscErrorCode (*f)(void*,Vec,Vec,void*) = (PetscErrorCode (*)(void*,Vec,Vec,void *))coloring->f;
PetscErrorCode ierr;
PetscInt k,start,end,l,row,col,srow,**vscaleforrow;
PetscScalar dx,*y,*xx,*w3_array;
PetscScalar *vscale_array;
PetscReal epsilon = coloring->error_rel,umin = coloring->umin,unorm;
Vec w1=coloring->w1,w2=coloring->w2,w3;
void *fctx = coloring->fctx;
PetscBool flg = PETSC_FALSE;
PetscInt ctype=coloring->ctype,N,col_start=0,col_end=0;
Vec x1_tmp;
PetscFunctionBegin;
PetscValidHeaderSpecific(J,MAT_CLASSID,1);
PetscValidHeaderSpecific(coloring,MAT_FDCOLORING_CLASSID,2);
PetscValidHeaderSpecific(x1,VEC_CLASSID,3);
if (!f) SETERRQ(((PetscObject)J)->comm,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");
ierr = PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
ierr = MatSetUnfactored(J);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(PETSC_NULL,"-mat_fd_coloring_dont_rezero",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
} else {
PetscBool assembled;
ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(J);CHKERRQ(ierr);
}
}
x1_tmp = x1;
if (!coloring->vscale){
ierr = VecDuplicate(x1_tmp,&coloring->vscale);CHKERRQ(ierr);
}
if (coloring->htype[0] == 'w') { /* tacky test; need to make systematic if we add other approaches to computing h*/
ierr = VecNorm(x1_tmp,NORM_2,&unorm);CHKERRQ(ierr);
}
ierr = VecGetOwnershipRange(w1,&start,&end);CHKERRQ(ierr); /* OwnershipRange is used by ghosted x! */
/* Set w1 = F(x1) */
if (!coloring->fset) {
ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
ierr = (*f)(sctx,x1_tmp,w1,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
} else {
coloring->fset = PETSC_FALSE;
}
if (!coloring->w3) {
ierr = VecDuplicate(x1_tmp,&coloring->w3);CHKERRQ(ierr);
ierr = PetscLogObjectParent(coloring,coloring->w3);CHKERRQ(ierr);
}
w3 = coloring->w3;
/* Compute all the local scale factors, including ghost points */
ierr = VecGetLocalSize(x1_tmp,&N);CHKERRQ(ierr);
ierr = VecGetArray(x1_tmp,&xx);CHKERRQ(ierr);
ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
if (ctype == IS_COLORING_GHOSTED){
col_start = 0; col_end = N;
} else if (ctype == IS_COLORING_GLOBAL){
xx = xx - start;
vscale_array = vscale_array - start;
col_start = start; col_end = N + start;
}
for (col=col_start; col<col_end; col++){
/* Loop over each local column, vscale[col] = 1./(epsilon*dx[col]) */
if (coloring->htype[0] == 'w') {
dx = 1.0 + unorm;
} else {
dx = xx[col];
}
if (dx == (PetscScalar)0.0) dx = 1.0;
if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0) dx = umin;
else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
dx *= epsilon;
vscale_array[col] = (PetscScalar)1.0/dx;
}
if (ctype == IS_COLORING_GLOBAL) vscale_array = vscale_array + start;
ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
if (ctype == IS_COLORING_GLOBAL){
ierr = VecGhostUpdateBegin(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGhostUpdateEnd(coloring->vscale,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
if (coloring->vscaleforrow) {
vscaleforrow = coloring->vscaleforrow;
} else SETERRQ(((PetscObject)J)->comm,PETSC_ERR_ARG_NULL,"Null Object: coloring->vscaleforrow");
/*
Loop over each color
*/
ierr = VecGetArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
for (k=0; k<coloring->ncolors; k++) {
coloring->currentcolor = k;
ierr = VecCopy(x1_tmp,w3);CHKERRQ(ierr);
ierr = VecGetArray(w3,&w3_array);CHKERRQ(ierr);
if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array - start;
/*
Loop over each column associated with color
adding the perturbation to the vector w3.
*/
for (l=0; l<coloring->ncolumns[k]; l++) {
col = coloring->columns[k][l]; /* local column of the matrix we are probing for */
if (coloring->htype[0] == 'w') {
dx = 1.0 + unorm;
} else {
dx = xx[col];
}
if (dx == (PetscScalar)0.0) dx = 1.0;
if (PetscAbsScalar(dx) < umin && PetscRealPart(dx) >= 0.0) dx = umin;
else if (PetscRealPart(dx) < 0.0 && PetscAbsScalar(dx) < umin) dx = -umin;
dx *= epsilon;
if (!PetscAbsScalar(dx)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed 0 differencing parameter");
w3_array[col] += dx;
}
if (ctype == IS_COLORING_GLOBAL) w3_array = w3_array + start;
ierr = VecRestoreArray(w3,&w3_array);CHKERRQ(ierr);
/*
Evaluate function at w3 = x1 + dx (here dx is a vector of perturbations)
w2 = F(x1 + dx) - F(x1)
*/
ierr = PetscLogEventBegin(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
ierr = (*f)(sctx,w3,w2,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringFunction,0,0,0,0);CHKERRQ(ierr);
ierr = VecAXPY(w2,-1.0,w1);CHKERRQ(ierr);
/*
Loop over rows of vector, putting results into Jacobian matrix
*/
ierr = VecGetArray(w2,&y);CHKERRQ(ierr);
for (l=0; l<coloring->nrows[k]; l++) {
row = coloring->rows[k][l]; /* local row index */
col = coloring->columnsforrow[k][l]; /* global column index */
y[row] *= vscale_array[vscaleforrow[k][l]];
srow = row + start;
ierr = MatSetValues(J,1,&srow,1,&col,y+row,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArray(w2,&y);CHKERRQ(ierr);
} /* endof for each color */
if (ctype == IS_COLORING_GLOBAL) xx = xx + start;
ierr = VecRestoreArray(coloring->vscale,&vscale_array);CHKERRQ(ierr);
ierr = VecRestoreArray(x1_tmp,&xx);CHKERRQ(ierr);
coloring->currentcolor = -1;
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
ierr = MatFDColoringViewFromOptions(coloring,"-mat_fd_coloring_view");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormHessian - Evaluates Hessian matrix.
Input Parameters:
. tao - the Tao context
. x - input vector
. ptr - optional user-defined context, as set by TaoSetHessianRoutine()
Output Parameters:
. A - Hessian matrix
. B - optionally different preconditioning matrix
Notes:
Due to mesh point reordering with DMs, we must always work
with the local mesh points, and then transform them to the new
global numbering with the local-to-global mapping. We cannot work
directly with the global numbers for the original uniprocessor mesh!
Two methods are available for imposing this transformation
when setting matrix entries:
(A) MatSetValuesLocal(), using the local ordering (including
ghost points!)
- Do the following two steps once, before calling TaoSolve()
- Use DMGetISLocalToGlobalMapping() to extract the
local-to-global map from the DM
- Associate this map with the matrix by calling
MatSetLocalToGlobalMapping()
- Then set matrix entries using the local ordering
by calling MatSetValuesLocal()
(B) MatSetValues(), using the global ordering
- Use DMGetGlobalIndices() to extract the local-to-global map
- Then apply this map explicitly yourself
- Set matrix entries using the global ordering by calling
MatSetValues()
Option (A) seems cleaner/easier in many cases, and is the procedure
used in this example.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat Hptr, Mat Hessian, void *ptr)
{
PetscErrorCode ierr;
AppCtx *user = (AppCtx *) ptr;
PetscInt i,j,k,row;
PetscInt mx=user->mx, my=user->my;
PetscInt xs,xm,gxs,gxm,ys,ym,gys,gym,col[7];
PetscReal hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
PetscReal rhx=mx+1, rhy=my+1;
PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscReal hl,hr,ht,hb,hc,htl,hbr;
PetscReal *x,*left,*right,*bottom,*top;
PetscReal v[7];
Vec localX = user->localX;
PetscBool assembled;
/* Set various matrix options */
ierr = MatSetOption(Hessian,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
/* Initialize matrix entries to zero */
ierr = MatAssembled(Hessian,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(Hessian);CHKERRQ(ierr);}
/* Get local mesh boundaries */
ierr = DMDAGetCorners(user->dm,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
ierr = DMDAGetGhostCorners(user->dm,&gxs,&gys,NULL,&gxm,&gym,NULL);CHKERRQ(ierr);
/* Scatter ghost points to local vector */
ierr = DMGlobalToLocalBegin(user->dm,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->dm,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = VecGetArray(localX,&x);CHKERRQ(ierr);
ierr = VecGetArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecGetArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecGetArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecGetArray(user->Right,&right);CHKERRQ(ierr);
/* Compute Hessian over the locally owned part of the mesh */
for (i=xs; i< xs+xm; i++){
for (j=ys; j<ys+ym; j++){
row=(j-gys)*gxm + (i-gxs);
xc = x[row];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left side */
if (i==gxs){
xl= left[j-ys+1];
xlt = left[j-ys+2];
} else {
xl = x[row-1];
}
if (j==gys){
xb=bottom[i-xs+1];
xrb = bottom[i-xs+2];
} else {
xb = x[row-gxm];
}
if (i+1 == gxs+gxm){
xr=right[j-ys+1];
xrb = right[j-ys];
} else {
xr = x[row+1];
}
if (j+1==gys+gym){
xt=top[i-xs+1];
xlt = top[i-xs];
}else {
xt = x[row+gxm];
}
if (i>gxs && j+1<gys+gym){
xlt = x[row-1+gxm];
}
if (j>gys && i+1<gxs+gxm){
xrb = x[row+1-gxm];
}
d1 = (xc-xl)*rhx;
d2 = (xc-xr)*rhx;
d3 = (xc-xt)*rhy;
d4 = (xc-xb)*rhy;
d5 = (xrb-xr)*rhy;
d6 = (xrb-xb)*rhx;
d7 = (xlt-xl)*rhy;
d8 = (xlt-xt)*rhx;
f1 = PetscSqrtScalar( 1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar( 1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar( 1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar( 1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+
(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+
(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+
(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+
(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) +
hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) +
(hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl*=0.5; hr*=0.5; ht*=0.5; hb*=0.5; hbr*=0.5; htl*=0.5; hc*=0.5;
k=0;
if (j>0){
v[k]=hb; col[k]=row - gxm; k++;
}
if (j>0 && i < mx -1){
v[k]=hbr; col[k]=row - gxm+1; k++;
}
if (i>0){
v[k]= hl; col[k]=row - 1; k++;
}
v[k]= hc; col[k]=row; k++;
if (i < mx-1 ){
v[k]= hr; col[k]=row+1; k++;
}
if (i>0 && j < my-1 ){
v[k]= htl; col[k] = row+gxm-1; k++;
}
if (j < my-1 ){
v[k]= ht; col[k] = row+gxm; k++;
}
/*
Set matrix values using local numbering, which was defined
earlier, in the main routine.
*/
ierr = MatSetValuesLocal(Hessian,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Restore vectors */
ierr = VecRestoreArray(localX,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Right,&right);CHKERRQ(ierr);
/* Assemble the matrix */
ierr = MatAssemblyBegin(Hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(199*xm*ym);CHKERRQ(ierr);
return 0;
}
/*
WholeMSurfHessian - Evaluates Hessian over the whole grid
Input:
daapplication - TAO application object
da - distributed array
X - the current point, at which the function and gradient are evaluated
ptr - user-defined application context
Output:
H - Hessian at X
*/
static int WholeMSurfHessian(TAO_APPLICATION daapplication, DA da, Vec X, Mat H, void *ptr) {
AppCtx *user = (AppCtx*)ptr;
Vec localX;
int info;
PetscInt i, j, ind[4];
PetscInt xs, xm, gxs, gxm, xe, ys, ym, gys, gym, ye;
double smallH[4][4];
double **x;
double hx, hy, area, byhxhx, byhyhy;
double dvdx, dvdy, flow, fup;
double areadivf, areadivf3;
PetscTruth assembled;
hx = user->hx;
hy = user->hy;
area = user->area;
byhxhx = 1.0 / (hx * hx);
byhyhy = 1.0 / (hy * hy);
info = DAGetLocalVector(da, &localX); CHKERRQ(info);
info = MatAssembled(H,&assembled); CHKERRQ(info);
if (assembled){info = MatZeroEntries(H); CHKERRQ(info);}
info = DAGlobalToLocalBegin(da, X, INSERT_VALUES, localX); CHKERRQ(info);
info = DAGlobalToLocalEnd(da, X, INSERT_VALUES, localX); CHKERRQ(info);
info = DAVecGetArray(da, localX, (void**)&x); CHKERRQ(info);
info = DAGetCorners(da, &xs, &ys, TAO_NULL, &xm, &ym, TAO_NULL); CHKERRQ(info);
info = DAGetGhostCorners(da, &gxs, &gys, TAO_NULL, &gxm, &gym, TAO_NULL); CHKERRQ(info);
xe = gxs + gxm - 1;
ye = gys + gym - 1;
for (j = ys; j < ye; j++) {
for (i = xs; i < xe; i++) {
/* 0 is 0,0; 1 is 1,0; 2 is 0,1; 3 is 1,1 */
dvdx = (x[j][i] - x[j][i+1]) / hx; /* lower triangle contribution */
dvdy = (x[j][i] - x[j+1][i]) / hy;
flow = sqrt( 1 + dvdx * dvdx + dvdy * dvdy );
dvdx = dvdx / hx;
dvdy = dvdy / hy;
areadivf = area / flow;
areadivf3 = areadivf / (flow * flow);
smallH[0][0] = areadivf * (byhxhx + byhyhy) - areadivf3 * (dvdx + dvdy) * (dvdx + dvdy);
smallH[0][1] = areadivf * (-byhxhx) + areadivf3 * (dvdx + dvdy) * (dvdx);
smallH[0][2] = areadivf * (-byhyhy) + areadivf3 * (dvdx + dvdy) * (dvdy);
smallH[0][3] = 0.0;
smallH[1][1] = areadivf * byhxhx - areadivf3 * dvdx * dvdx;
smallH[1][2] = areadivf3 * (-dvdx) * dvdy;
smallH[2][2] = areadivf * byhyhy - areadivf3 * dvdy * dvdy;
/* upper triangle contribution */
dvdx = (x[j+1][i+1] - x[j+1][i]) / hx;
dvdy = (x[j+1][i+1] - x[j][i+1]) / hy;
fup = sqrt( 1 + dvdx * dvdx + dvdy * dvdy );
dvdx = dvdx / hx;
dvdy = dvdy / hy;
areadivf = area / fup;
areadivf3 = areadivf / (fup * fup);
smallH[1][1] += areadivf * byhyhy - areadivf3 * dvdy * dvdy;
smallH[1][2] += areadivf3 * (-dvdy) * dvdx;
smallH[2][2] += areadivf * byhxhx - areadivf3 * (dvdx * dvdx);
smallH[1][3] = areadivf * (-byhyhy) + areadivf3 * (dvdx + dvdy) * dvdy;
smallH[2][3] = areadivf * (-byhxhx) + areadivf3 * (dvdx + dvdy) * dvdx;
smallH[3][3] = areadivf * (byhxhx + byhyhy) - areadivf3 * (dvdx + dvdy) * (dvdx + dvdy);
smallH[1][0] = smallH[0][1];
smallH[2][0] = smallH[0][2];
smallH[3][0] = smallH[0][3];
smallH[2][1] = smallH[1][2];
smallH[3][1] = smallH[1][3];
smallH[3][2] = smallH[2][3];
ind[0] = (j-gys) * gxm + (i-gxs);
ind[1] = ind[0] + 1;
ind[2] = ind[0] + gxm;
ind[3] = ind[2] + 1;
info = MatSetValuesLocal(H,4,ind,4,ind,(PetscScalar*)smallH,ADD_VALUES); CHKERRQ(info);
}
}
info = DAVecRestoreArray(da, localX, (void**)&x); CHKERRQ(info);
info = MatAssemblyBegin(H, MAT_FINAL_ASSEMBLY); CHKERRQ(info);
info = MatAssemblyEnd(H, MAT_FINAL_ASSEMBLY); CHKERRQ(info);
info = MatSetOption(H, MAT_SYMMETRIC, PETSC_TRUE); CHKERRQ(info);
info = DARestoreLocalVector(da, &localX); CHKERRQ(info);
info = PetscLogFlops((xe-xs) * (ye-ys) * 83 + 4); CHKERRQ(info);
return 0;
} /* WholeMSurfHessian */
