1 #include <petsc/private/fortranimpl.h> 2 #include <petscds.h> 3 #include <petscviewer.h> 4 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 12 13 static PetscFortranCallbackId riemannsolver; 14 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 } 23 24 PETSC_EXTERN void petscdssetcontext_(PetscDS *prob, PetscInt *f, void *ctx, PetscErrorCode *ierr) 25 { 26 *ierr = PetscDSSetContext(*prob, *f, *prob); 27 if (*ierr) return; 28 } 29 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 } 37