PETSC_EXTERN void PETSC_STDCALL matmffdsetfunction_(Mat *mat,void (PETSC_STDCALL *func)(void*,Vec*,Vec*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
{
CHKFORTRANNULLOBJECT(ctx);
PetscObjectAllocateFortranPointers(*mat,2);
((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)func;
((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)(PETSC_UINTPTR_T)ctx;
*ierr = MatMFFDSetFunction(*mat,ourmatmffdfunction,*mat);
}
PetscErrorCode ComputeJacobian_MF(SNES snes,Vec x,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = MatMFFDSetFunction(A,(PetscErrorCode (*)(void*,Vec,Vec))SNESComputeFunction,snes);CHKERRQ(ierr);
ierr = MatMFFDSetBase(A,x,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
#undef __FUNCT__
#define __FUNCT__ "MatCreateSNESMF"
/*@
MatCreateSNESMF - Creates a matrix-free matrix context for use with
a SNES solver. This matrix can be used as the Jacobian argument for
the routine SNESSetJacobian(). See MatCreateMFFD() for details on how
the finite difference computation is done.
Collective on SNES and Vec
Input Parameters:
. snes - the SNES context
Output Parameter:
. J - the matrix-free matrix
Level: advanced
Warning:
If MatMFFDSetBase() is ever called on jac then this routine will NO longer get
the x from the SNES object and MatMFFDSetBase() must from that point on be used to
change the base vector x.
Notes: The difference between this routine and MatCreateMFFD() is that this matrix
automatically gets the current base vector from the SNES object and not from an
explicit call to MatMFFDSetBase().
.seealso: MatDestroy(), MatMFFDSetFunctionError(), MatMFFDDSSetUmin()
MatMFFDSetHHistory(), MatMFFDResetHHistory(), MatCreateMFFD(),
MatMFFDGetH(), MatMFFDRegisterDynamic), MatMFFDComputeJacobian()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT MatCreateSNESMF(SNES snes,Mat *J)
{
PetscErrorCode ierr;
PetscInt n,N;
PetscFunctionBegin;
if (!snes->vec_func) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"SNESSetFunction() must be called first");
ierr = VecGetLocalSize(snes->vec_func,&n);CHKERRQ(ierr);
ierr = VecGetSize(snes->vec_func,&N);CHKERRQ(ierr);
ierr = MatCreateMFFD(((PetscObject)snes)->comm,n,n,N,N,J);CHKERRQ(ierr);
ierr = MatMFFDSetFunction(*J,(PetscErrorCode (*)(void*,Vec,Vec))SNESComputeFunction,snes);CHKERRQ(ierr);
(*J)->ops->assemblyend = MatAssemblyEnd_SNESMF;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)*J,"MatMFFDSetBase_C","MatMFFDSetBase_SNESMF",MatMFFDSetBase_SNESMF);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TaoDefaultComputeHessianMFFD(Tao tao,Vec X,Mat H,Mat B,void *ctx)
{
PetscInt n,N;
PetscErrorCode ierr;
PetscFunctionBegin;
if (B && B != H) SETERRQ(PetscObjectComm((PetscObject)tao),PETSC_ERR_SUP,"Preconditioning Hessian matrix");
ierr = VecGetSize(X,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
ierr = MatSetSizes(H,n,n,N,N);CHKERRQ(ierr);
ierr = MatSetType(H,MATMFFD);CHKERRQ(ierr);
ierr = MatSetUp(H);CHKERRQ(ierr);
ierr = MatMFFDSetBase(H,X,NULL);CHKERRQ(ierr);
ierr = MatMFFDSetFunction(H,(PetscErrorCode (*)(void*,Vec,Vec))TaoComputeGradient,tao);CHKERRQ(ierr);
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
