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