Actual source code: zdsf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscds.h>
3: #include <petscviewer.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define petscdssetcontext_ PETSCDSSETCONTEXT
7: #define petscdssetriemannsolver_ PETSCDSSETRIEMANNSOLVER
8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9: #define petscdssetcontext_ petscdssetcontext
10: #define petscdssetriemannsolver_ petscdssetriemannsolver
11: #endif
13: static PetscFortranCallbackId riemannsolver;
15: // We can't use PetscObjectUseFortranCallback() because this function returns void
16: static void ourriemannsolver(PetscInt dim, PetscInt Nf, const PetscReal x[], const PetscReal n[], const PetscScalar uL[], const PetscScalar uR[], PetscInt numConstants, const PetscScalar constants[], PetscScalar flux[], void *ctx)
17: {
18: void (*func)(PetscInt *dim, PetscInt *Nf, const PetscReal x[], const PetscReal n[], const PetscScalar uL[], const PetscScalar uR[], const PetscInt *numConstants, const PetscScalar constants[], PetscScalar flux[], void *ctx);
19: void *_ctx;
20: PetscCallAbort(PETSC_COMM_SELF, PetscObjectGetFortranCallback((PetscObject)ctx, PETSC_FORTRAN_CALLBACK_CLASS, riemannsolver, (PetscVoidFn **)&func, &_ctx));
21: if (func) { (*func)(&dim, &Nf, x, n, uL, uR, &numConstants, constants, flux, _ctx); }
22: }
24: PETSC_EXTERN void petscdssetcontext_(PetscDS *prob, PetscInt *f, void *ctx, PetscErrorCode *ierr)
25: {
26: *ierr = PetscDSSetContext(*prob, *f, ctx);
27: if (*ierr) return;
28: }
30: PETSC_EXTERN void petscdssetriemannsolver_(PetscDS *prob, PetscInt *f, void (*rs)(PetscInt *, PetscInt *, PetscReal *, PetscReal *, PetscScalar *, PetscScalar *, PetscInt *, PetscScalar *, PetscScalar *, void *, PetscErrorCode *), PetscErrorCode *ierr)
31: {
32: *ierr = PetscObjectSetFortranCallback((PetscObject)*prob, PETSC_FORTRAN_CALLBACK_CLASS, &riemannsolver, (PetscVoidFn *)rs, NULL);
33: if (*ierr) return;
34: *ierr = PetscDSSetRiemannSolver(*prob, *f, ourriemannsolver);
35: if (*ierr) return;
36: }