Actual source code: zmodpcff.c

      1: #include <petsc/private/ftnimpl.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 (fcn == kspfgmresmodifypcksp_) {
     37:     *ierr = KSPFGMRESSetModifyPC(*ksp, KSPFGMRESModifyPCKSP, NULL, NULL);
     38:   } else if (fcn == kspfgmresmodifypcnochange_) {
     39:     *ierr = KSPFGMRESSetModifyPC(*ksp, KSPFGMRESModifyPCNoChange, 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 = KSPFGMRESSetModifyPC(*ksp, ourmodify, *ksp, ourmoddestroy);
     46:   }
     47: }