xref: /petsc/src/snes/linesearch/impls/shell/ftn-custom/zlinesearchshellf.c (revision ea5d4fccf296dd2bbd0f9c3a3343651cb1066da7) !
1*ea5d4fccSPeter Brune #include <private/fortranimpl.h>
2*ea5d4fccSPeter Brune #include <petscsnes.h>
3*ea5d4fccSPeter Brune 
4*ea5d4fccSPeter Brune #if defined(PETSC_HAVE_FORTRAN_CAPS)
5*ea5d4fccSPeter Brune #define petsclinesearchshellsetuserfunc_          PETSCLINESEARCHSHELLSETUSERFUNC
6*ea5d4fccSPeter Brune #define petsclinesearchshellgetuserfunc_          PETSCLINESEARCHSHELLGETUSERFUNC
7*ea5d4fccSPeter Brune #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
8*ea5d4fccSPeter Brune #define petsclinesearchshellsetuserfunc_          petsclinesearchshellsetuserfunc
9*ea5d4fccSPeter Brune #define petsclinesearchshellgetuserfunc_          petsclinesearchshellgetuserfunc
10*ea5d4fccSPeter Brune #endif
11*ea5d4fccSPeter Brune 
12*ea5d4fccSPeter Brune static PetscErrorCode ourpetsclinesearchshellfunction(PetscLineSearch linesearch, void *ctx)
13*ea5d4fccSPeter Brune {
14*ea5d4fccSPeter Brune   PetscErrorCode ierr = 0;
15*ea5d4fccSPeter Brune   (*(void (PETSC_STDCALL *)(PetscLineSearch*,void*,PetscErrorCode*))(((PetscObject)linesearch)->fortran_func_pointers[0]))(&linesearch,ctx,&ierr);CHKERRQ(ierr);
16*ea5d4fccSPeter Brune   return 0;
17*ea5d4fccSPeter Brune }
18*ea5d4fccSPeter Brune 
19*ea5d4fccSPeter Brune EXTERN_C_BEGIN
20*ea5d4fccSPeter Brune 
21*ea5d4fccSPeter Brune void PETSC_STDCALL petsclinesearchshellsetuserfunc_(PetscLineSearch *linesearch,
22*ea5d4fccSPeter Brune                                                     void (PETSC_STDCALL *func)(PetscLineSearch*,void*,PetscErrorCode*),
23*ea5d4fccSPeter Brune                                                     void *ctx,
24*ea5d4fccSPeter Brune                                                     PetscErrorCode *ierr)
25*ea5d4fccSPeter Brune {
26*ea5d4fccSPeter Brune   PetscObjectAllocateFortranPointers(*linesearch,1);
27*ea5d4fccSPeter Brune   ((PetscObject)*linesearch)->fortran_func_pointers[0] = (PetscVoidFunction)func;
28*ea5d4fccSPeter Brune   *ierr = PetscLineSearchShellSetUserFunc(*linesearch,ourpetsclinesearchshellfunction,ctx);
29*ea5d4fccSPeter Brune }
30*ea5d4fccSPeter Brune 
31*ea5d4fccSPeter Brune void PETSC_STDCALL petsclinesearchshellgetuserfunc_(PetscLineSearch *linesearch, void * func, void **ctx,PetscErrorCode *ierr)
32*ea5d4fccSPeter Brune {
33*ea5d4fccSPeter Brune 
34*ea5d4fccSPeter Brune   CHKFORTRANNULLINTEGER(ctx);
35*ea5d4fccSPeter Brune   *ierr = PetscLineSearchShellGetUserFunc(*linesearch,PETSC_NULL,ctx);
36*ea5d4fccSPeter Brune }
37*ea5d4fccSPeter Brune EXTERN_C_END
38