xref: /petsc/src/dm/dt/interface/ftn-custom/zdsf.c (revision e0e713dd5769a304dc3a61b5ad480e981b5b38f1)
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
7*e0e713ddStbridel #define petscdsview_  PETSCDSVIEW
8*e0e713ddStbridel #define petscdssetcontext_  PETSCDSSETCONTEXT
9*e0e713ddStbridel #define petscdssetriemannsolver_ PETSCDSSETRIEMANNSOLVER
10fe2efc57SMark #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
11fe2efc57SMark #define petscdsviewfromoptions_   petscdsviewfromoptions
12*e0e713ddStbridel #define petscdsview_  petscdsview
13*e0e713ddStbridel #define petscdssetcontext_ petscdssetcontext
14*e0e713ddStbridel #define petscdssetriemannsolver_ petscdssetriemannsolver
15fe2efc57SMark #endif
16fe2efc57SMark 
17*e0e713ddStbridel static PetscFortranCallbackId riemannsolver;
18*e0e713ddStbridel 
19*e0e713ddStbridel static PetscErrorCode ourriemannsolver(PetscInt dim,PetscInt Nf,PetscReal x[],PetscReal n[],PetscScalar uL[],PetscScalar uR[],PetscInt numConstants,PetscScalar constants[],PetscScalar flux[],void *ctx)
20*e0e713ddStbridel {
21*e0e713ddStbridel   PetscObjectUseFortranCallback((PetscDS)ctx,riemannsolver,(PetscInt*,PetscInt*,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscInt*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*),(&dim,&Nf,x,n,uL,uR,&numConstants,constants,flux,_ctx,&ierr));
22*e0e713ddStbridel }
23*e0e713ddStbridel 
2419caf8f3SSatish Balay PETSC_EXTERN void petscdsviewfromoptions_(PetscDS *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
25fe2efc57SMark {
26fe2efc57SMark   char *t;
27fe2efc57SMark 
28fe2efc57SMark   FIXCHAR(type,len,t);
29fe2efc57SMark   *ierr = PetscDSViewFromOptions(*ao,obj,t);if (*ierr) return;
30fe2efc57SMark   FREECHAR(type,t);
31fe2efc57SMark }
32fe2efc57SMark 
33*e0e713ddStbridel PETSC_EXTERN void petscdsview_(PetscDS *prob,PetscViewer *vin,PetscErrorCode *ierr)
34*e0e713ddStbridel {
35*e0e713ddStbridel   PetscViewer v;
36*e0e713ddStbridel   PetscPatchDefaultViewers_Fortran(vin,v);
37*e0e713ddStbridel   *ierr = PetscDSView(*prob,v);if (*ierr) return;
38*e0e713ddStbridel }
39*e0e713ddStbridel 
40*e0e713ddStbridel PETSC_EXTERN void petscdssetcontext_(PetscDS *prob,PetscInt *f,void *ctx,PetscErrorCode *ierr)
41*e0e713ddStbridel {
42*e0e713ddStbridel   *ierr = PetscDSSetContext(*prob,*f,*prob);if (*ierr) return;
43*e0e713ddStbridel }
44*e0e713ddStbridel 
45*e0e713ddStbridel PETSC_EXTERN void petscdssetriemannsolver_(PetscDS *prob,PetscInt *f,void (*rs)(PetscInt*,PetscInt*,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscInt*,PetscScalar*,PetscScalar*,void*,PetscErrorCode*),PetscErrorCode *ierr)
46*e0e713ddStbridel {
47*e0e713ddStbridel   *ierr = PetscObjectSetFortranCallback((PetscObject)*prob,PETSC_FORTRAN_CALLBACK_CLASS,&riemannsolver,(PetscVoidFunction)rs,NULL);if (*ierr) return;
48*e0e713ddStbridel   *ierr = PetscDSSetRiemannSolver(*prob,*f,(void*)ourriemannsolver);if (*ierr) return;
49*e0e713ddStbridel }