1fe2efc57SMark #include <petsc/private/fortranimpl.h> 2fe2efc57SMark #include <petscds.h> 3fe2efc57SMark #include <petscviewer.h> 4fe2efc57SMark 5fe2efc57SMark #if defined(PETSC_HAVE_FORTRAN_CAPS) 6fe2efc57SMark #define petscdsviewfromoptions_ PETSCDSVIEWFROMOPTIONS 7e0e713ddStbridel #define petscdsview_ PETSCDSVIEW 8e0e713ddStbridel #define petscdssetcontext_ PETSCDSSETCONTEXT 9e0e713ddStbridel #define petscdssetriemannsolver_ PETSCDSSETRIEMANNSOLVER 10fe2efc57SMark #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11fe2efc57SMark #define petscdsviewfromoptions_ petscdsviewfromoptions 12e0e713ddStbridel #define petscdsview_ petscdsview 13e0e713ddStbridel #define petscdssetcontext_ petscdssetcontext 14e0e713ddStbridel #define petscdssetriemannsolver_ petscdssetriemannsolver 15fe2efc57SMark #endif 16fe2efc57SMark 17e0e713ddStbridel static PetscFortranCallbackId riemannsolver; 18e0e713ddStbridel 19*0f1503a6SJed Brown // We can't use PetscObjectUseFortranCallback() because this function returns void 20*0f1503a6SJed 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) 21e0e713ddStbridel { 22*0f1503a6SJed Brown PetscErrorCode ierr; \ 23*0f1503a6SJed 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); 24*0f1503a6SJed Brown void *_ctx; 25*0f1503a6SJed Brown ierr = PetscObjectGetFortranCallback((PetscObject)ctx,PETSC_FORTRAN_CALLBACK_CLASS,riemannsolver,(PetscVoidFunction*)&func,&_ctx);CHKERRABORT(PETSC_COMM_SELF,ierr); 26*0f1503a6SJed Brown if (func) { 27*0f1503a6SJed Brown (*func)(&dim,&Nf,x,n,uL,uR,&numConstants,constants,flux,_ctx); 28*0f1503a6SJed Brown } 29e0e713ddStbridel } 30e0e713ddStbridel 3119caf8f3SSatish Balay PETSC_EXTERN void petscdsviewfromoptions_(PetscDS *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 32fe2efc57SMark { 33fe2efc57SMark char *t; 34fe2efc57SMark 35fe2efc57SMark FIXCHAR(type,len,t); 36b14c0cbaSBlaise Bourdin CHKFORTRANNULLOBJECT(obj); 37fe2efc57SMark *ierr = PetscDSViewFromOptions(*ao,obj,t);if (*ierr) return; 38fe2efc57SMark FREECHAR(type,t); 39fe2efc57SMark } 40fe2efc57SMark 41e0e713ddStbridel PETSC_EXTERN void petscdsview_(PetscDS *prob,PetscViewer *vin,PetscErrorCode *ierr) 42e0e713ddStbridel { 43e0e713ddStbridel PetscViewer v; 44e0e713ddStbridel PetscPatchDefaultViewers_Fortran(vin,v); 45e0e713ddStbridel *ierr = PetscDSView(*prob,v);if (*ierr) return; 46e0e713ddStbridel } 47e0e713ddStbridel 48e0e713ddStbridel PETSC_EXTERN void petscdssetcontext_(PetscDS *prob,PetscInt *f,void *ctx,PetscErrorCode *ierr) 49e0e713ddStbridel { 50e0e713ddStbridel *ierr = PetscDSSetContext(*prob,*f,*prob);if (*ierr) return; 51e0e713ddStbridel } 52e0e713ddStbridel 53e0e713ddStbridel PETSC_EXTERN void petscdssetriemannsolver_(PetscDS *prob,PetscInt *f,void (*rs)(PetscInt*,PetscInt*,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscInt*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*),PetscErrorCode *ierr) 54e0e713ddStbridel { 55e0e713ddStbridel *ierr = PetscObjectSetFortranCallback((PetscObject)*prob,PETSC_FORTRAN_CALLBACK_CLASS,&riemannsolver,(PetscVoidFunction)rs,NULL);if (*ierr) return; 56*0f1503a6SJed Brown *ierr = PetscDSSetRiemannSolver(*prob,*f,ourriemannsolver);if (*ierr) return; 57e0e713ddStbridel } 58