static PetscErrorCode MatSetFromOptions_MFFD(PetscOptionItems *PetscOptionsObject,Mat mat)
{
MatMFFD mfctx = (MatMFFD)mat->data;
PetscErrorCode ierr;
PetscBool flg;
char ftype[256];
PetscFunctionBegin;
PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
PetscValidHeaderSpecific(mfctx,MATMFFD_CLASSID,1);
ierr = PetscObjectOptionsBegin((PetscObject)mfctx);CHKERRQ(ierr);
ierr = PetscOptionsFList("-mat_mffd_type","Matrix free type","MatMFFDSetType",MatMFFDList,((PetscObject)mfctx)->type_name,ftype,256,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatMFFDSetType(mat,ftype);CHKERRQ(ierr);
}
ierr = PetscOptionsReal("-mat_mffd_err","set sqrt relative error in function","MatMFFDSetFunctionError",mfctx->error_rel,&mfctx->error_rel,0);CHKERRQ(ierr);
ierr = PetscOptionsInt("-mat_mffd_period","how often h is recomputed","MatMFFDSetPeriod",mfctx->recomputeperiod,&mfctx->recomputeperiod,0);CHKERRQ(ierr);
flg = PETSC_FALSE;
ierr = PetscOptionsBool("-mat_mffd_check_positivity","Insure that U + h*a is nonnegative","MatMFFDSetCheckh",flg,&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = MatMFFDSetCheckh(mat,MatMFFDCheckPositivity,0);CHKERRQ(ierr);
}
#if defined(PETSC_USE_COMPLEX)
ierr = PetscOptionsBool("-mat_mffd_complex","Use Lyness complex number trick to compute the matrix-vector product","None",mfctx->usecomplex,&mfctx->usecomplex,NULL);CHKERRQ(ierr);
#endif
if (mfctx->ops->setfromoptions) {
ierr = (*mfctx->ops->setfromoptions)(PetscOptionsObject,mfctx);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
MatMult_MFFD - Default matrix-free form for Jacobian-vector product, y = F'(u)*a:
y ~= (F(u + ha) - F(u))/h,
where F = nonlinear function, as set by SNESSetFunction()
u = current iterate
h = difference interval
*/
static PetscErrorCode MatMult_MFFD(Mat mat,Vec a,Vec y)
{
MatMFFD ctx = (MatMFFD)mat->data;
PetscScalar h;
Vec w,U,F;
PetscErrorCode ierr;
PetscBool zeroa;
PetscFunctionBegin;
if (!ctx->current_u) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"MatMFFDSetBase() has not been called, this is often caused by forgetting to call \n\t\tMatAssemblyBegin/End on the first Mat in the SNES compute function");
/* We log matrix-free matrix-vector products separately, so that we can
separate the performance monitoring from the cases that use conventional
storage. We may eventually modify event logging to associate events
with particular objects, hence alleviating the more general problem. */
ierr = PetscLogEventBegin(MATMFFD_Mult,a,y,0,0);CHKERRQ(ierr);
w = ctx->w;
U = ctx->current_u;
F = ctx->current_f;
/*
Compute differencing parameter
*/
if (!((PetscObject)ctx)->type_name) {
ierr = MatMFFDSetType(mat,MATMFFD_WP);CHKERRQ(ierr);
ierr = MatSetFromOptions(mat);CHKERRQ(ierr);
}
ierr = (*ctx->ops->compute)(ctx,U,a,&h,&zeroa);CHKERRQ(ierr);
if (zeroa) {
ierr = VecSet(y,0.0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (mat->erroriffailure && PetscIsInfOrNanScalar(h)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed Nan differencing parameter h");
if (ctx->checkh) {
ierr = (*ctx->checkh)(ctx->checkhctx,U,a,&h);CHKERRQ(ierr);
}
/* keep a record of the current differencing parameter h */
ctx->currenth = h;
#if defined(PETSC_USE_COMPLEX)
ierr = PetscInfo2(mat,"Current differencing parameter: %g + %g i\n",(double)PetscRealPart(h),(double)PetscImaginaryPart(h));CHKERRQ(ierr);
#else
ierr = PetscInfo1(mat,"Current differencing parameter: %15.12e\n",h);CHKERRQ(ierr);
#endif
if (ctx->historyh && ctx->ncurrenth < ctx->maxcurrenth) {
ctx->historyh[ctx->ncurrenth] = h;
}
ctx->ncurrenth++;
#if defined(PETSC_USE_COMPLEX)
if (ctx->usecomplex) h = PETSC_i*h;
#endif
/* w = u + ha */
if (ctx->drscale) {
ierr = VecPointwiseMult(ctx->drscale,a,U);CHKERRQ(ierr);
ierr = VecAYPX(U,h,w);CHKERRQ(ierr);
} else {
ierr = VecWAXPY(w,h,a,U);CHKERRQ(ierr);
}
/* compute func(U) as base for differencing; only needed first time in and not when provided by user */
if (ctx->ncurrenth == 1 && ctx->current_f_allocated) {
ierr = (*ctx->func)(ctx->funcctx,U,F);CHKERRQ(ierr);
}
ierr = (*ctx->func)(ctx->funcctx,w,y);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
if (ctx->usecomplex) {
ierr = VecImaginaryPart(y);CHKERRQ(ierr);
h = PetscImaginaryPart(h);
} else {
ierr = VecAXPY(y,-1.0,F);CHKERRQ(ierr);
}
#else
ierr = VecAXPY(y,-1.0,F);CHKERRQ(ierr);
#endif
ierr = VecScale(y,1.0/h);CHKERRQ(ierr);
ierr = VecAXPBY(y,ctx->vshift,ctx->vscale,a);CHKERRQ(ierr);
if (ctx->dlscale) {
ierr = VecPointwiseMult(y,ctx->dlscale,y);CHKERRQ(ierr);
}
if (ctx->dshift) {
if (!ctx->dshiftw) {
ierr = VecDuplicate(y,&ctx->dshiftw);CHKERRQ(ierr);
}
ierr = VecPointwiseMult(ctx->dshift,a,ctx->dshiftw);CHKERRQ(ierr);
ierr = VecAXPY(y,1.0,ctx->dshiftw);CHKERRQ(ierr);
}
if (mat->nullsp) {ierr = MatNullSpaceRemove(mat->nullsp,y);CHKERRQ(ierr);}
ierr = PetscLogEventEnd(MATMFFD_Mult,a,y,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
(*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))((void*)(PETSC_UINTPTR_T)((PetscObject)mat)->fortran_func_pointers[1],&x,&f,&ierr);CHKERRQ(ierr);
return 0;
}
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);
}
PETSC_EXTERN void PETSC_STDCALL matmffdsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
FIXCHAR(ftype,len,t);
*ierr = MatMFFDSetType(*mat,t);
FREECHAR(ftype,t);
}
PETSC_EXTERN void PETSC_STDCALL matmffdsetoptionsprefix_(Mat *mat,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
FIXCHAR(prefix,len,t);
*ierr = MatMFFDSetOptionsPrefix(*mat,t);
FREECHAR(prefix,t);
}