xref: /petsc/src/mat/impls/mffd/ftn-custom/zmffdf.c (revision 6a98f8dc3f2c9149905a87dc2e9d0fedaf64e09a)
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   PetscErrorCode ierr = 0;
19   Mat            mat  = (Mat) ctx;
20   (*(void (*)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))((void*)(PETSC_UINTPTR_T)((PetscObject)mat)->fortran_func_pointers[1],&x,&f,&ierr);CHKERRQ(ierr);
21   return 0;
22 }
23 
24 PETSC_EXTERN void matmffdsetfunction_(Mat *mat,void (*func)(void*,Vec*,Vec*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
25 {
26   PetscObjectAllocateFortranPointers(*mat,2);
27   ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)func;
28   ((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)(PETSC_UINTPTR_T)ctx;
29 
30   *ierr = MatMFFDSetFunction(*mat,ourmatmffdfunction,*mat);
31 }
32 
33 PETSC_EXTERN void matmffdsettype_(Mat *mat,char* ftype,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
34 {
35   char *t;
36   FIXCHAR(ftype,len,t);
37   *ierr = MatMFFDSetType(*mat,t);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);if (*ierr) return;
46   FREECHAR(prefix,t);
47 }
48 
49