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[], PetscCtx 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[], PetscCtx ctx);
     17:   void *_ctx;
     18:   PetscCallAbort(PETSC_COMM_SELF, PetscObjectGetFortranCallback((PetscObject)ctx, PETSC_FORTRAN_CALLBACK_CLASS, riemannsolver, (PetscFortranCallbackFn **)&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, (PetscFortranCallbackFn *)rs, NULL);
     25:   if (*ierr) return;
     26:   *ierr = PetscDSSetRiemannSolver(*prob, *f, ourriemannsolver);
     27:   if (*ierr) return;
     28: }