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