/*@ 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 */