xref: /petsc/src/mat/impls/mffd/ftn-custom/zmffdf.c (revision d5b43468fb8780a8feea140ccd6fa3e6a50411cc)
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 0;
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] = (PetscVoidFunction)func;
27   ((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)(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);if (*ierr) return;
37   FREECHAR(ftype,t);
38 }
39 
40 PETSC_EXTERN void matmffdsetoptionsprefix_(Mat *mat,char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
41 {
42   char *t;
43   FIXCHAR(prefix,len,t);
44   *ierr = MatMFFDSetOptionsPrefix(*mat,t);if (*ierr) return;
45   FREECHAR(prefix,t);
46 }
47