Actual source code: zmodpcff.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define kspfgmressetmodifypc_      KSPFGMRESSETMODIFYPC
  6:   #define kspfgmresmodifypcnochange_ KSPFGMRESMODIFYPCNOCHANGE
  7:   #define kspfgmresmodifypcksp_      KSPFGMRESMODIFYPCKSP
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define kspfgmressetmodifypc_      kspfgmressetmodifypc
 10:   #define kspfgmresmodifypcnochange_ kspfgmresmodifypcnochange
 11:   #define kspfgmresmodifypcksp_      kspfgmresmodifypcksp
 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, void *ctx)
 20: {
 21:   PetscObjectUseFortranCallbackSubType(ksp, _cb.modify, (KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&ksp, &i, &i2, &d, _ctx, &ierr));
 22: }

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

 30: PETSC_EXTERN void kspfgmresmodifypcnochange_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);
 31: PETSC_EXTERN void kspfgmresmodifypcksp_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);

 33: PETSC_EXTERN void kspfgmressetmodifypc_(KSP *ksp, void (*fcn)(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *ctx, void (*d)(void *, PetscErrorCode *), PetscErrorCode *ierr)
 34: {
 35:   CHKFORTRANNULLFUNCTION(d);
 36:   if ((PetscVoidFn *)fcn == (PetscVoidFn *)kspfgmresmodifypcksp_) {
 37:     *ierr = KSPFGMRESSetModifyPC(*ksp, KSPFGMRESModifyPCKSP, NULL, NULL);
 38:   } else if ((PetscVoidFn *)fcn == (PetscVoidFn *)kspfgmresmodifypcnochange_) {
 39:     *ierr = KSPFGMRESSetModifyPC(*ksp, KSPFGMRESModifyPCNoChange, NULL, NULL);
 40:   } else {
 41:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.modify, (PetscVoidFn *)fcn, ctx);
 42:     if (*ierr) return;
 43:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.destroy, (PetscVoidFn *)d, ctx);
 44:     if (*ierr) return;
 45:     *ierr = KSPFGMRESSetModifyPC(*ksp, ourmodify, *ksp, ourmoddestroy);
 46:   }
 47: }