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: }