1 #include <petsc/private/ftnimpl.h>
2 #include <petsc/private/kspimpl.h>
3
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define dmkspsetcomputerhs_ DMKSPSETCOMPUTERHS
6 #define dmkspsetcomputeinitialguess_ DMKSPSETCOMPUTEINITIALGUESS
7 #define dmkspsetcomputeoperators_ DMKSPSETCOMPUTEOPERATORS
8 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9 #define dmkspsetcomputerhs_ dmkspsetcomputerhs
10 #define dmkspsetcomputeinitialguess_ dmkspsetcomputeinitialguess
11 #define dmkspsetcomputeoperators_ dmkspsetcomputeoperators
12 #endif
13
ourkspcomputerhs(KSP ksp,Vec b,PetscCtx ctx)14 static PetscErrorCode ourkspcomputerhs(KSP ksp, Vec b, PetscCtx ctx)
15 {
16 DM dm;
17 DMKSP kdm;
18 PetscCall(KSPGetDM(ksp, &dm));
19 PetscCall(DMGetDMKSP(dm, &kdm));
20 PetscCallFortranVoidFunction((*(void (*)(KSP *, Vec *, void *, PetscErrorCode *))kdm->fortran_func_pointers[0])(&ksp, &b, ctx, &ierr));
21 return PETSC_SUCCESS;
22 }
23
ourkspcomputeinitialguess(KSP ksp,Vec b,PetscCtx ctx)24 static PetscErrorCode ourkspcomputeinitialguess(KSP ksp, Vec b, PetscCtx ctx)
25 {
26 DM dm;
27 DMKSP kdm;
28 PetscCall(KSPGetDM(ksp, &dm));
29 PetscCall(DMGetDMKSP(dm, &kdm));
30 PetscCallFortranVoidFunction((*(void (*)(KSP *, Vec *, void *, PetscErrorCode *))kdm->fortran_func_pointers[2])(&ksp, &b, ctx, &ierr));
31 return PETSC_SUCCESS;
32 }
33
ourkspcomputeoperators(KSP ksp,Mat A,Mat B,PetscCtx ctx)34 static PetscErrorCode ourkspcomputeoperators(KSP ksp, Mat A, Mat B, PetscCtx ctx)
35 {
36 DM dm;
37 DMKSP kdm;
38 PetscCall(KSPGetDM(ksp, &dm));
39 PetscCall(DMGetDMKSP(dm, &kdm));
40 PetscCallFortranVoidFunction((*(void (*)(KSP *, Mat *, Mat *, void *, PetscErrorCode *))kdm->fortran_func_pointers[1])(&ksp, &A, &B, ctx, &ierr));
41 return PETSC_SUCCESS;
42 }
43
44 /* The counting for fortran_func_pointers is insanely brittle. We're putting these inside the base DM, but we have no
45 * way to be sure there is room other than to grep the sources from src/dm (and any other possible client). Fortran
46 * function pointers need an overhaul.
47 */
48
dmkspsetcomputerhs_(DM * dm,void (* func)(KSP *,Vec *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)49 PETSC_EXTERN void dmkspsetcomputerhs_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
50 {
51 DMKSP kdm;
52 *ierr = DMGetDMKSP(*dm, &kdm);
53 if (!*ierr) {
54 kdm->fortran_func_pointers[0] = (PetscFortranCallbackFn *)func;
55 *ierr = DMKSPSetComputeRHS(*dm, ourkspcomputerhs, ctx);
56 }
57 }
58
dmkspsetcomputeinitialguess_(DM * dm,void (* func)(KSP *,Vec *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)59 PETSC_EXTERN void dmkspsetcomputeinitialguess_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
60 {
61 DMKSP kdm;
62 *ierr = DMGetDMKSP(*dm, &kdm);
63 if (!*ierr) {
64 kdm->fortran_func_pointers[2] = (PetscFortranCallbackFn *)func;
65
66 *ierr = DMKSPSetComputeInitialGuess(*dm, ourkspcomputeinitialguess, ctx);
67 }
68 }
69
dmkspsetcomputeoperators_(DM * dm,void (* func)(KSP *,Vec *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)70 PETSC_EXTERN void dmkspsetcomputeoperators_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
71 {
72 DMKSP kdm;
73 *ierr = DMGetDMKSP(*dm, &kdm);
74 if (!*ierr) {
75 kdm->fortran_func_pointers[1] = (PetscFortranCallbackFn *)func;
76 *ierr = DMKSPSetComputeOperators(*dm, ourkspcomputeoperators, ctx);
77 }
78 }
79