Actual source code: zdmkspf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petsc/private/kspimpl.h>
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 /* zdmkspf.c */
10: #define dmkspsetcomputeinitialguess_ dmkspsetcomputeinitialguess /* zdmkspf.c */
11: #define dmkspsetcomputeoperators_ dmkspsetcomputeoperators /* zdmkspf */
12: #endif
14: static PetscErrorCode ourkspcomputerhs(KSP ksp, Vec b, void *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: }
24: static PetscErrorCode ourkspcomputeinitialguess(KSP ksp, Vec b, void *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: }
34: static PetscErrorCode ourkspcomputeoperators(KSP ksp, Mat A, Mat B, void *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: }
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: */
49: PETSC_EXTERN void dmkspsetcomputerhs_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
50: {
51: DMKSP kdm;
52: *ierr = DMGetDMKSP(*dm, &kdm);
53: if (!*ierr) {
54: kdm->fortran_func_pointers[0] = (PetscVoidFn *)func;
55: *ierr = DMKSPSetComputeRHS(*dm, ourkspcomputerhs, ctx);
56: }
57: }
59: PETSC_EXTERN void dmkspsetcomputeinitialguess_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
60: {
61: DMKSP kdm;
62: *ierr = DMGetDMKSP(*dm, &kdm);
63: if (!*ierr) {
64: kdm->fortran_func_pointers[2] = (PetscVoidFn *)func;
66: *ierr = DMKSPSetComputeInitialGuess(*dm, ourkspcomputeinitialguess, ctx);
67: }
68: }
70: PETSC_EXTERN void dmkspsetcomputeoperators_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
71: {
72: DMKSP kdm;
73: *ierr = DMGetDMKSP(*dm, &kdm);
74: if (!*ierr) {
75: kdm->fortran_func_pointers[1] = (PetscVoidFn *)func;
76: *ierr = DMKSPSetComputeOperators(*dm, ourkspcomputeoperators, ctx);
77: }
78: }