1: #include <petsc/private/ftnimpl.h>
  2: #include <petscksp.h>

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define kspflexiblesetmodifypc_      KSPFLEXIBLESETMODIFYPC
  6:   #define kspflexiblemodifypcnochange_ KSPFLEXIBLEMODIFYPCNOCHANGE
  7:   #define kspflexiblemodifypcksp_      KSPFLEXIBLEMODIFYPCKSP
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define kspflexiblesetmodifypc_      kspflexiblesetmodifypc
 10:   #define kspflexiblemodifypcnochange_ kspflexiblemodifypcnochange
 11:   #define kspflexiblemodifypcksp_      kspflexiblemodifypcksp
 12: #endif

 14: static struct {
 15:   PetscFortranCallbackId modify;
 16:   PetscFortranCallbackId destroy;
 17: } _cb;

 19: static PetscErrorCode ourmodify(KSP ksp, PetscInt i, PetscInt i2, PetscReal d, PetscCtx ctx)
 20: {
 21:   PetscObjectUseFortranCallbackSubType(ksp, _cb.modify, (KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&ksp, &i, &i2, &d, _ctx, &ierr));
 22: }

 24: static PetscErrorCode ourmoddestroy(PetscCtxRt ctx)
 25: {
 26:   KSP ksp = *(KSP *)ctx;
 27:   PetscObjectUseFortranCallbackSubType(ksp, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
 28: }

 30: PETSC_EXTERN void kspflexiblemodifypcnochange_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);
 31: PETSC_EXTERN void kspflexiblemodifypcksp_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);

 33: PETSC_EXTERN void kspflexiblesetmodifypc_(KSP *ksp, void (*fcn)(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *), PetscCtx ctx, void (*d)(void *, PetscErrorCode *), PetscErrorCode *ierr)
 34: {
 35:   CHKFORTRANNULLFUNCTION(d);
 36:   if (fcn == kspflexiblemodifypcksp_) {
 37:     *ierr = KSPFlexibleSetModifyPC(*ksp, KSPFlexibleModifyPCKSP, NULL, NULL);
 38:   } else if (fcn == kspflexiblemodifypcnochange_) {
 39:     *ierr = KSPFlexibleSetModifyPC(*ksp, KSPFlexibleModifyPCNoChange, NULL, NULL);
 40:   } else {
 41:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.modify, (PetscFortranCallbackFn *)fcn, ctx);
 42:     if (*ierr) return;
 43:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.destroy, (PetscFortranCallbackFn *)d, ctx);
 44:     if (*ierr) return;
 45:     *ierr = KSPFlexibleSetModifyPC(*ksp, ourmodify, *ksp, ourmoddestroy);
 46:   }
 47: }