xref: /petsc/src/mat/impls/mffd/ftn-custom/zmffdf.c (revision 98d129c30f3ee9fdddc40fdbc5a989b7be64f888)
1 #include <petsc/private/fortranimpl.h>
2 #include <petscmat.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5   #define matmffdsetfunction_      MATMFFDSETFUNCTION
6   #define matmffdsettype_          MATMFFDSETTYPE
7   #define matmffdsetoptionsprefix_ MATMFFDSETOPTIONSPREFIX
8   #define matmffdsetbase_          MATMFFDSETBASE
9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
10   #define matmffdsetfunction_      matmffdsetfunction
11   #define matmffdsettype_          matmffdsettype
12   #define matmffdsetoptionsprefix_ matmffdsetoptionsprefix
13   #define matmffdsetbase_          matmffdsetbase
14 #endif
15 
16 static PetscErrorCode ourmatmffdfunction(void *ctx, Vec x, Vec f)
17 {
18   Mat mat = (Mat)ctx;
19   PetscCallFortranVoidFunction((*(void (*)(void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)mat)->fortran_func_pointers[0]))((void *)(PETSC_UINTPTR_T)((PetscObject)mat)->fortran_func_pointers[1], &x, &f, &ierr));
20   return PETSC_SUCCESS;
21 }
22 
23 PETSC_EXTERN void matmffdsetfunction_(Mat *mat, void (*func)(void *, Vec *, Vec *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
24 {
25   PetscObjectAllocateFortranPointers(*mat, 2);
26   ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFn *)func;
27   ((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFn *)(PETSC_UINTPTR_T)ctx;
28 
29   *ierr = MatMFFDSetFunction(*mat, ourmatmffdfunction, *mat);
30 }
31 
32 PETSC_EXTERN void matmffdsettype_(Mat *mat, char *ftype, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
33 {
34   char *t;
35   FIXCHAR(ftype, len, t);
36   *ierr = MatMFFDSetType(*mat, t);
37   if (*ierr) return;
38   FREECHAR(ftype, t);
39 }
40 
41 PETSC_EXTERN void matmffdsetoptionsprefix_(Mat *mat, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
42 {
43   char *t;
44   FIXCHAR(prefix, len, t);
45   *ierr = MatMFFDSetOptionsPrefix(*mat, t);
46   if (*ierr) return;
47   FREECHAR(prefix, t);
48 }
49