1 #include <petsc/private/ftnimpl.h>
2 #include <petscksp.h>
3
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
13
14 static struct {
15 PetscFortranCallbackId modify;
16 PetscFortranCallbackId destroy;
17 } _cb;
18
ourmodify(KSP ksp,PetscInt i,PetscInt i2,PetscReal d,PetscCtx ctx)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 }
23
ourmoddestroy(PetscCtxRt ctx)24 static PetscErrorCode ourmoddestroy(PetscCtxRt ctx)
25 {
26 KSP ksp = *(KSP *)ctx;
27 PetscObjectUseFortranCallbackSubType(ksp, _cb.destroy, (void *, PetscErrorCode *), (_ctx, &ierr));
28 }
29
30 PETSC_EXTERN void kspflexiblemodifypcnochange_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);
31 PETSC_EXTERN void kspflexiblemodifypcksp_(KSP *, PetscInt *, PetscInt *, PetscReal *, void *, PetscErrorCode *);
32
kspflexiblesetmodifypc_(KSP * ksp,void (* fcn)(KSP *,PetscInt *,PetscInt *,PetscReal *,void *,PetscErrorCode *),PetscCtx ctx,void (* d)(void *,PetscErrorCode *),PetscErrorCode * ierr)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 }
48