xref: /petsc/src/snes/interface/ftn-custom/zsnesf.c (revision dfef5ea798a36ccc664ca1bbe435d183ec21e5c1)

#include <petsc/private/fortranimpl.h>
#include <petscsnes.h>
#include <petscviewer.h>
#include <petsc/private/f90impl.h>

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define snesconvergedreasonview_         SNESCONVERGEDREASONVIEW
  #define snessetpicard_                   SNESSETPICARD
  #define matmffdcomputejacobian_          MATMFFDCOMPUTEJACOBIAN
  #define snessolve_                       SNESSOLVE
  #define snescomputejacobiandefault_      SNESCOMPUTEJACOBIANDEFAULT
  #define snescomputejacobiandefaultcolor_ SNESCOMPUTEJACOBIANDEFAULTCOLOR
  #define snessetjacobian_                 SNESSETJACOBIAN
  #define snessetjacobian1_                SNESSETJACOBIAN1
  #define snessetjacobian2_                SNESSETJACOBIAN2
  #define snesgetoptionsprefix_            SNESGETOPTIONSPREFIX
  #define snesgettype_                     SNESGETTYPE
  #define snessetfunction_                 SNESSETFUNCTION
  #define snessetngs_                      SNESSETNGS
  #define snessetupdate_                   SNESSETUPDATE
  #define snesgetfunction_                 SNESGETFUNCTION
  #define snesgetngs_                      SNESGETNGS
  #define snessetconvergencetest_          SNESSETCONVERGENCETEST
  #define snesconvergeddefault_            SNESCONVERGEDDEFAULT
  #define snesconvergedskip_               SNESCONVERGEDSKIP
  #define snesview_                        SNESVIEW
  #define snesgetconvergencehistory_       SNESGETCONVERGENCEHISTORY
  #define snesgetjacobian_                 SNESGETJACOBIAN
  #define snessettype_                     SNESSETTYPE
  #define snesappendoptionsprefix_         SNESAPPENDOPTIONSPREFIX
  #define snessetoptionsprefix_            SNESSETOPTIONSPREFIX
  #define snesmonitordefault_              SNESMONITORDEFAULT
  #define snesmonitorsolution_             SNESMONITORSOLUTION
  #define snesmonitorsolutionupdate_       SNESMONITORSOLUTIONUPDATE
  #define snesmonitorset_                  SNESMONITORSET
  #define snesnewtontrsetprecheck_         SNESNEWTONTRSETPRECHECK
  #define snesnewtontrsetpostcheck_        SNESNEWTONTRSETPOSTCHECK
  #define snesnewtontrdcsetprecheck_       SNESNEWTONTRDCSETPRECHECK
  #define snesnewtontrdcsetpostcheck_      SNESNEWTONTRDCSETPOSTCHECK
  #define snesviewfromoptions_             SNESVIEWFROMOPTIONS
  #define snesgetconvergedreasonstring_    SNESGETCONVERGEDREASONSTRING
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define snesconvergedreasonview_         snesconvergedreasonview
  #define snessetpicard_                   snessetpicard
  #define matmffdcomputejacobian_          matmffdcomputejacobian
  #define snessolve_                       snessolve
  #define snescomputejacobiandefault_      snescomputejacobiandefault
  #define snescomputejacobiandefaultcolor_ snescomputejacobiandefaultcolor
  #define snessetjacobian_                 snessetjacobian
  #define snessetjacobian1_                snessetjacobian1
  #define snessetjacobian2_                snessetjacobian2
  #define snesgetoptionsprefix_            snesgetoptionsprefix
  #define snesgettype_                     snesgettype
  #define snessetfunction_                 snessetfunction
  #define snessetngs_                      snessetngs
  #define snessetupdate_                   snessetupdate
  #define snesgetfunction_                 snesgetfunction
  #define snesgetngs_                      snesgetngs
  #define snessetconvergencetest_          snessetconvergencetest
  #define snesconvergeddefault_            snesconvergeddefault
  #define snesconvergedskip_               snesconvergedskip
  #define snesview_                        snesview
  #define snesgetjacobian_                 snesgetjacobian
  #define snesgetconvergencehistory_       snesgetconvergencehistory
  #define snessettype_                     snessettype
  #define snesappendoptionsprefix_         snesappendoptionsprefix
  #define snessetoptionsprefix_            snessetoptionsprefix
  #define snesmonitordefault_              snesmonitordefault
  #define snesmonitorsolution_             snesmonitorsolution
  #define snesmonitorsolutionupdate_       snesmonitorsolutionupdate
  #define snesmonitorset_                  snesmonitorset
  #define snesnewtontrsetprecheck_         snesnewtontrsetprecheck
  #define snesnewtontrsetpostcheck_        snesnewtontrsetpostcheck
  #define snesnewtontrdcsetprecheck_       snesnewtontrdcsetprecheck
  #define snesnewtontrdcsetpostcheck_      snesnewtontrdcsetpostcheck
  #define snesviewfromoptions_             snesviewfromoptions
  #define snesgetconvergedreasonstring_    snesgetconvergedreasonstring
#endif

static struct {
  PetscFortranCallbackId function;
  PetscFortranCallbackId test;
  PetscFortranCallbackId destroy;
  PetscFortranCallbackId jacobian;
  PetscFortranCallbackId monitor;
  PetscFortranCallbackId mondestroy;
  PetscFortranCallbackId ngs;
  PetscFortranCallbackId update;
  PetscFortranCallbackId trprecheck;
  PetscFortranCallbackId trpostcheck;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  PetscFortranCallbackId function_pgiptr;
  PetscFortranCallbackId trprecheck_pgiptr;
  PetscFortranCallbackId trpostcheck_pgiptr;
#endif
} _cb;

static PetscErrorCode ourtrprecheckfunction(SNES snes, Vec x, Vec y, PetscBool *changed_y, void *ctx)
{
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  void *ptr;
  PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trprecheck_pgiptr, NULL, &ptr));
#endif
  PetscObjectUseFortranCallback(snes, _cb.trprecheck, (SNES *, Vec *, Vec *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, changed_y, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
}

PETSC_EXTERN void snesnewtontrsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = SNESNewtonTRSetPreCheck(*snes, ourtrprecheckfunction, NULL);
}

PETSC_EXTERN void snesnewtontrdcsetprecheck_(SNES *snes, void (*func)(SNES, Vec, Vec, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trprecheck_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = SNESNewtonTRDCSetPreCheck(*snes, ourtrprecheckfunction, NULL);
}

static PetscErrorCode ourtrpostcheckfunction(SNES snes, Vec x, Vec y, Vec w, PetscBool *changed_y, PetscBool *changed_w, void *ctx)
{
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  void *ptr;
  PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.trpostcheck_pgiptr, NULL, &ptr));
#endif
  PetscObjectUseFortranCallback(snes, _cb.trpostcheck, (SNES *, Vec *, Vec *, Vec *, PetscBool *, PetscBool *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &y, &w, changed_y, changed_w, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
}

PETSC_EXTERN void snesnewtontrsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = SNESNewtonTRSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
}

PETSC_EXTERN void snesnewtontrdcsetpostcheck_(SNES *snes, void (*func)(SNES, Vec, Vec, Vec, PetscBool *, PetscBool *, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.trpostcheck_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = SNESNewtonTRDCSetPostCheck(*snes, ourtrpostcheckfunction, NULL);
}

static PetscErrorCode oursnesfunction(SNES snes, Vec x, Vec f, void *ctx)
{
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  void *ptr;
  PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
#endif
  PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
}

static PetscErrorCode oursnestest(SNES snes, PetscInt it, PetscReal a, PetscReal d, PetscReal c, SNESConvergedReason *reason, void *ctx)
{
  PetscObjectUseFortranCallback(snes, _cb.test, (SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), (&snes, &it, &a, &d, &c, reason, _ctx, &ierr));
}

static PetscErrorCode ourdestroy(void *ctx)
{
  PetscObjectUseFortranCallback(ctx, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
}

static PetscErrorCode oursnesjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
{
  PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
}

static PetscErrorCode oursnesupdate(SNES snes, PetscInt i)
{
  PetscObjectUseFortranCallback(snes, _cb.update, (SNES *, PetscInt *, PetscErrorCode *), (&snes, &i, &ierr));
}
static PetscErrorCode oursnesngs(SNES snes, Vec x, Vec b, void *ctx)
{
  PetscObjectUseFortranCallback(snes, _cb.ngs, (SNES *, Vec *, Vec *, void *, PetscErrorCode *), (&snes, &x, &b, _ctx, &ierr));
}
static PetscErrorCode oursnesmonitor(SNES snes, PetscInt i, PetscReal d, void *ctx)
{
  PetscObjectUseFortranCallback(snes, _cb.monitor, (SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&snes, &i, &d, _ctx, &ierr));
}
static PetscErrorCode ourmondestroy(void **ctx)
{
  SNES snes = (SNES)*ctx;
  PetscObjectUseFortranCallback(snes, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
}

/*
     snescomputejacobiandefault() and snescomputejacobiandefaultcolor()
  These can be used directly from Fortran but are mostly so that
  Fortran SNESSetJacobian() will properly handle the defaults being passed in.
*/
PETSC_EXTERN void matmffdcomputejacobian_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
{
  *ierr = MatMFFDComputeJacobian(*snes, *x, *m, *p, ctx);
}
PETSC_EXTERN void snescomputejacobiandefault_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
{
  *ierr = SNESComputeJacobianDefault(*snes, *x, *m, *p, ctx);
}
PETSC_EXTERN void snescomputejacobiandefaultcolor_(SNES *snes, Vec *x, Mat *m, Mat *p, void *ctx, PetscErrorCode *ierr)
{
  *ierr = SNESComputeJacobianDefaultColor(*snes, *x, *m, *p, *(MatFDColoring *)ctx);
}

PETSC_EXTERN void snessetjacobian_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
  CHKFORTRANNULLFUNCTION(func);
  if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefault_) {
    *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefault, ctx);
  } else if ((PetscVoidFunction)func == (PetscVoidFunction)snescomputejacobiandefaultcolor_) {
    if (!ctx) {
      *ierr = PETSC_ERR_ARG_NULL;
      return;
    }
    *ierr = SNESSetJacobian(*snes, *A, *B, SNESComputeJacobianDefaultColor, *(MatFDColoring *)ctx);
  } else if ((PetscVoidFunction)func == (PetscVoidFunction)matmffdcomputejacobian_) {
    *ierr = SNESSetJacobian(*snes, *A, *B, MatMFFDComputeJacobian, ctx);
  } else {
    *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFunction)func, ctx);
    if (!*ierr) *ierr = SNESSetJacobian(*snes, *A, *B, oursnesjacobian, NULL);
  }
}
PETSC_EXTERN void snessetjacobian1_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
  snessetjacobian_(snes, A, B, func, ctx, ierr);
}
PETSC_EXTERN void snessetjacobian2_(SNES *snes, Mat *A, Mat *B, void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
  snessetjacobian_(snes, A, B, func, ctx, ierr);
}

static PetscErrorCode oursnespicardfunction(SNES snes, Vec x, Vec f, void *ctx)
{
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  void *ptr;
  PetscCall(PetscObjectGetFortranCallback((PetscObject)snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function_pgiptr, NULL, &ptr));
#endif
  PetscObjectUseFortranCallback(snes, _cb.function, (SNES *, Vec *, Vec *, void *, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&snes, &x, &f, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
}

static PetscErrorCode oursnespicardjacobian(SNES snes, Vec x, Mat m, Mat p, void *ctx)
{
  PetscObjectUseFortranCallback(snes, _cb.jacobian, (SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&snes, &x, &m, &p, _ctx, &ierr));
}

PETSC_EXTERN void snessetpicard_(SNES *snes, Vec *r, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), Mat *A, Mat *B, PetscErrorCode (*J)(SNES, Vec, Mat, Mat, void *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFunction)func, ctx);
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacobian, (PetscVoidFunction)J, ctx);
  if (!*ierr) *ierr = SNESSetPicard(*snes, *r, oursnespicardfunction, *A, *B, oursnespicardjacobian, NULL);
}

PETSC_EXTERN void snesgetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  const char *tname;

  *ierr = SNESGetOptionsPrefix(*snes, &tname);
  *ierr = PetscStrncpy(prefix, tname, len);
  if (*ierr) return;
  FIXRETURNCHAR(PETSC_TRUE, prefix, len);
}

PETSC_EXTERN void snesgettype_(SNES *snes, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  const char *tname;

  *ierr = SNESGetType(*snes, &tname);
  *ierr = PetscStrncpy(name, tname, len);
  if (*ierr) return;
  FIXRETURNCHAR(PETSC_TRUE, name, len);
}

/*
   These are not usually called from Fortran but allow Fortran users
   to transparently set these monitors from .F code
*/

PETSC_EXTERN void snessetfunction_(SNES *snes, Vec *r, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
#if defined(PETSC_HAVE_F90_2PTR_ARG)
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.function_pgiptr, NULL, ptr);
  if (*ierr) return;
#endif
  *ierr = SNESSetFunction(*snes, *r, oursnesfunction, NULL);
}

PETSC_EXTERN void snessetngs_(SNES *snes, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.ngs, (PetscVoidFunction)func, ctx);
  if (*ierr) return;
  *ierr = SNESSetNGS(*snes, oursnesngs, NULL);
}
PETSC_EXTERN void snessetupdate_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
{
  *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFunction)func, NULL);
  if (*ierr) return;
  *ierr = SNESSetUpdate(*snes, oursnesupdate);
}

/* the func argument is ignored */
PETSC_EXTERN void snesgetfunction_(SNES *snes, Vec *r, void (*func)(SNES, Vec, Vec, void *), void **ctx, PetscErrorCode *ierr)
{
  CHKFORTRANNULLOBJECT(r);
  *ierr = SNESGetFunction(*snes, r, NULL, NULL);
  if (*ierr) return;
  if ((PetscVoidFunction)func == (PetscVoidFunction)PETSC_NULL_FUNCTION_Fortran) return;
  *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.function, NULL, ctx);
}

PETSC_EXTERN void snesgetngs_(SNES *snes, void *func, void **ctx, PetscErrorCode *ierr)
{
  *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.ngs, NULL, ctx);
}

PETSC_EXTERN void snesconvergeddefault_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
{
  *ierr = SNESConvergedDefault(*snes, *it, *a, *b, *c, r, ct);
}

PETSC_EXTERN void snesconvergedskip_(SNES *snes, PetscInt *it, PetscReal *a, PetscReal *b, PetscReal *c, SNESConvergedReason *r, void *ct, PetscErrorCode *ierr)
{
  *ierr = SNESConvergedSkip(*snes, *it, *a, *b, *c, r, ct);
}

PETSC_EXTERN void snessetconvergencetest_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, PetscReal *, PetscReal *, SNESConvergedReason *, void *, PetscErrorCode *), void *cctx, void (*destroy)(void *), PetscErrorCode *ierr)
{
  CHKFORTRANNULLFUNCTION(destroy);

  if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergeddefault_) {
    *ierr = SNESSetConvergenceTest(*snes, SNESConvergedDefault, NULL, NULL);
  } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesconvergedskip_) {
    *ierr = SNESSetConvergenceTest(*snes, SNESConvergedSkip, NULL, NULL);
  } else {
    *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscVoidFunction)func, cctx);
    if (*ierr) return;
    *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscVoidFunction)destroy, cctx);
    if (*ierr) return;
    *ierr = SNESSetConvergenceTest(*snes, oursnestest, *snes, ourdestroy);
  }
}

PETSC_EXTERN void snesview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
{
  PetscViewer v;
  PetscPatchDefaultViewers_Fortran(viewer, v);
  *ierr = SNESView(*snes, v);
}

/*  func is currently ignored from Fortran */
PETSC_EXTERN void snesgetjacobian_(SNES *snes, Mat *A, Mat *B, int *func, void **ctx, PetscErrorCode *ierr)
{
  CHKFORTRANNULLINTEGER(ctx);
  CHKFORTRANNULLOBJECT(A);
  CHKFORTRANNULLOBJECT(B);
  *ierr = SNESGetJacobian(*snes, A, B, NULL, NULL);
  if (*ierr) return;
  *ierr = PetscObjectGetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, _cb.jacobian, NULL, ctx);
}

PETSC_EXTERN void snesgetconvergencehistory_(SNES *snes, PetscInt *na, PetscErrorCode *ierr)
{
  *ierr = SNESGetConvergenceHistory(*snes, NULL, NULL, na);
}

PETSC_EXTERN void snessettype_(SNES *snes, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  char *t;

  FIXCHAR(type, len, t);
  *ierr = SNESSetType(*snes, t);
  if (*ierr) return;
  FREECHAR(type, t);
}

PETSC_EXTERN void snesappendoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  char *t;

  FIXCHAR(prefix, len, t);
  *ierr = SNESAppendOptionsPrefix(*snes, t);
  if (*ierr) return;
  FREECHAR(prefix, t);
}

PETSC_EXTERN void snessetoptionsprefix_(SNES *snes, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  char *t;

  FIXCHAR(prefix, len, t);
  *ierr = SNESSetOptionsPrefix(*snes, t);
  if (*ierr) return;
  FREECHAR(prefix, t);
}

PETSC_EXTERN void snesmonitordefault_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
{
  *ierr = SNESMonitorDefault(*snes, *its, *fgnorm, *dummy);
}

PETSC_EXTERN void snesmonitorsolution_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
{
  *ierr = SNESMonitorSolution(*snes, *its, *fgnorm, *dummy);
}

PETSC_EXTERN void snesmonitorsolutionupdate_(SNES *snes, PetscInt *its, PetscReal *fgnorm, PetscViewerAndFormat **dummy, PetscErrorCode *ierr)
{
  *ierr = SNESMonitorSolutionUpdate(*snes, *its, *fgnorm, *dummy);
}

PETSC_EXTERN void snesmonitorset_(SNES *snes, void (*func)(SNES *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
{
  CHKFORTRANNULLFUNCTION(mondestroy);
  if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitordefault_) {
    *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorDefault, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
  } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolution_) {
    *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
  } else if ((PetscVoidFunction)func == (PetscVoidFunction)snesmonitorsolutionupdate_) {
    *ierr = SNESMonitorSet(*snes, (PetscErrorCode(*)(SNES, PetscInt, PetscReal, void *))SNESMonitorSolutionUpdate, *(PetscViewerAndFormat **)mctx, (PetscErrorCode(*)(void **))PetscViewerAndFormatDestroy);
  } else {
    *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscVoidFunction)func, mctx);
    if (*ierr) return;
    *ierr = PetscObjectSetFortranCallback((PetscObject)*snes, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFunction)mondestroy, mctx);
    if (*ierr) return;
    *ierr = SNESMonitorSet(*snes, oursnesmonitor, *snes, ourmondestroy);
  }
}

PETSC_EXTERN void snesviewfromoptions_(SNES *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  char *t;

  FIXCHAR(type, len, t);
  CHKFORTRANNULLOBJECT(obj);
  *ierr = SNESViewFromOptions(*ao, obj, t);
  if (*ierr) return;
  FREECHAR(type, t);
}

PETSC_EXTERN void snesconvergedreasonview_(SNES *snes, PetscViewer *viewer, PetscErrorCode *ierr)
{
  PetscViewer v;
  PetscPatchDefaultViewers_Fortran(viewer, v);
  *ierr = SNESConvergedReasonView(*snes, v);
}

PETSC_EXTERN void snesgetconvergedreasonstring_(SNES *snes, char *strreason, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
{
  const char *tstrreason;
  *ierr = SNESGetConvergedReasonString(*snes, &tstrreason);
  *ierr = PetscStrncpy(strreason, tstrreason, len);
  if (*ierr) return;
  FIXRETURNCHAR(PETSC_TRUE, strreason, len);
}