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