PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
MatColoring mc;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec,matcolor = PETSC_FALSE;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
if (!color) {ierr = PetscObjectQuery((PetscObject)B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
matcolor = PETSC_FALSE;
ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_fd_color_use_mat",&matcolor,NULL);CHKERRQ(ierr);
if (hascolor && !matcolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else {
ierr = MatColoringCreate(B,&mc);CHKERRQ(ierr);
ierr = MatColoringSetDistance(mc,2);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
Vec F;
ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,color,x1,snes);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmlocalsnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (A != B) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
PetscErrorCode (*func)(SNES,Vec,Vec,void*);
Vec F;
void *funcctx;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
else {ierr = PetscObjectQuery((PetscObject)*B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
*flag = SAME_NONZERO_PATTERN;
ierr = SNESGetFunction(snes,&F,&func,&funcctx);CHKERRQ(ierr);
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
if (hascolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
} else {
ierr = MatGetColoring(*B,MATCOLORINGSL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,(void*)funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)*B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(*B,color,x1,flag,snes);CHKERRQ(ierr);
if (*J != *B) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
TaoDefaultComputeHessianColor - Computes the Hessian using colored finite differences.
Collective on Tao
Input Parameters:
+ tao - the Tao context
. V - compute Hessian at this point
- ctx - the PetscColoring object (must be of type MatFDColoring)
Output Parameters:
+ H - Hessian matrix (not altered in this routine)
- B - newly computed Hessian matrix to use with preconditioner (generally the same as H)
Level: advanced
.seealso: TaoSetHessianRoutine(), TaoDefaultComputeHessian(),SNESComputeJacobianDefaultColor(), TaoSetGradientRoutine()
@*/
PetscErrorCode TaoDefaultComputeHessianColor(Tao tao,Vec V,Mat H,Mat B,void *ctx)
{
PetscErrorCode ierr;
MatFDColoring coloring = (MatFDColoring)ctx;
PetscFunctionBegin;
PetscValidHeaderSpecific(ctx,MAT_FDCOLORING_CLASSID,6);
ierr = PetscInfo(tao,"TAO computing matrix using finite differences Hessian and coloring\n");CHKERRQ(ierr);
ierr = MatFDColoringApply(B,coloring,V,ctx);CHKERRQ(ierr);
if (H != B) {
ierr = MatAssemblyBegin(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void PETSC_STDCALL matfdcoloringapply_(Mat J,MatFDColoring coloring,Vec x1,MatStructure *flag,void*sctx, int *__ierr ){
*__ierr = MatFDColoringApply(
(Mat)PetscToPointer((J) ),
(MatFDColoring)PetscToPointer((coloring) ),
(Vec)PetscToPointer((x1) ),flag,sctx);
}
static PetscErrorCode SNESComputeJacobian_DMDA(SNES snes,Vec X,Mat *A,Mat *B,MatStructure *mstr,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x;
PetscFunctionBegin;
if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmdasnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->jacobianlocal)(&info,x,*A,*B,mstr,dmdasnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMDA,dmdasnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
*mstr = SAME_NONZERO_PATTERN;
ierr = MatFDColoringApply(*B,fdcoloring,X,mstr,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (*A != *B) {
ierr = MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
