16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2fe2efc57SMark #include <petscds.h> 3fe2efc57SMark #include <petscviewer.h> 4fe2efc57SMark 5fe2efc57SMark #if defined(PETSC_HAVE_FORTRAN_CAPS) 6e0e713ddStbridel #define petscdssetriemannsolver_ PETSCDSSETRIEMANNSOLVER 7fe2efc57SMark #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8e0e713ddStbridel #define petscdssetriemannsolver_ petscdssetriemannsolver 9fe2efc57SMark #endif 10fe2efc57SMark 11e0e713ddStbridel static PetscFortranCallbackId riemannsolver; 12e0e713ddStbridel 130f1503a6SJed Brown // We can't use PetscObjectUseFortranCallback() because this function returns void 140f1503a6SJed Brown 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) 15e0e713ddStbridel { 160f1503a6SJed Brown 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); 170f1503a6SJed Brown void *_ctx; 18*5ebfa9e9SBarry Smith PetscCallAbort(PETSC_COMM_SELF, PetscObjectGetFortranCallback((PetscObject)ctx, PETSC_FORTRAN_CALLBACK_CLASS, riemannsolver, (PetscFortranCallbackFn **)&func, &_ctx)); 19ac530a7eSPierre Jolivet if (func) (*func)(&dim, &Nf, x, n, uL, uR, &numConstants, constants, flux, _ctx); 20e0e713ddStbridel } 21e0e713ddStbridel 22e0e713ddStbridel PETSC_EXTERN void petscdssetriemannsolver_(PetscDS *prob, PetscInt *f, void (*rs)(PetscInt *, PetscInt *, PetscReal *, PetscReal *, PetscScalar *, PetscScalar *, PetscInt *, PetscScalar *, PetscScalar *, void *, PetscErrorCode *), PetscErrorCode *ierr) 23e0e713ddStbridel { 24*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*prob, PETSC_FORTRAN_CALLBACK_CLASS, &riemannsolver, (PetscFortranCallbackFn *)rs, NULL); 255975b3b6SBarry Smith if (*ierr) return; 265975b3b6SBarry Smith *ierr = PetscDSSetRiemannSolver(*prob, *f, ourriemannsolver); 275975b3b6SBarry Smith if (*ierr) return; 28e0e713ddStbridel } 29