xref: /petsc/src/snes/linesearch/interface/ftn-custom/zlinesearchf.c (revision 4e8afd12df985612b40e26aef947da2f566aee4e) !
1 #include <petsc/private/fortranimpl.h>
2 #include <petscsnes.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define sneslinesearchgettype_          SNESLINESEARCHGETTYPE
6 #define sneslinesearchsettype_          SNESLINESEARCHSETTYPE
7 #define sneslinesearchsetprecheck_      SNESLINESEARCHSETPRECHECK
8 #define sneslinesearchgetprecheck_      SNESLINESEARCHGETPRECHECK
9 #define sneslinesearchsetpostcheck_     SNESLINESEARCHSETPOSTCHECK
10 #define sneslinesearchgetpostcheck_     SNESLINESEARCHGETPOSTCHECK
11 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
12 #define sneslinesearchgettype_          sneslinesearchgettype
13 #define sneslinesearchsettype_          sneslinesearchsettype
14 #define sneslinesearchsetprecheck_      sneslinesearchsetprecheck
15 #define sneslinesearchgetprecheck_      sneslinesearchgetprecheck
16 #define sneslinesearchsetpostcheck_     sneslinesearchsetpostcheck
17 #define sneslinesearchgetpostcheck_     sneslinesearchgetpostcheck
18 
19 #endif
20 
21 /* fortranpointers go: shell, precheck, postcheck */
22 
23 static PetscErrorCode oursneslinesearchprecheck(SNESLineSearch linesearch, Vec X, Vec Y, PetscBool * changed, void * ctx)
24 {
25   PetscErrorCode ierr = 0;
26   (*(void (*)(SNESLineSearch*,Vec*, Vec*, PetscBool*,void*,PetscErrorCode*))(((PetscObject)linesearch)->fortran_func_pointers[1]))(&linesearch,&X,&Y,changed,ctx,&ierr);CHKERRQ(ierr);
27   return 0;
28 }
29 
30 static PetscErrorCode oursneslinesearchpostcheck(SNESLineSearch linesearch, Vec X, Vec Y, Vec W, PetscBool * changed_Y, PetscBool * changed_W, void * ctx)
31 {
32   PetscErrorCode ierr = 0;
33   (*(void (*)(SNESLineSearch*,Vec*,Vec*,Vec*,PetscBool*,PetscBool*,void*,PetscErrorCode*))
34      (((PetscObject)linesearch)->fortran_func_pointers[2]))(&linesearch,&X,&Y,&W,changed_Y,changed_W,ctx,&ierr);CHKERRQ(ierr);
35   return 0;
36 }
37 
38 PETSC_EXTERN void sneslinesearchgettype_(SNESLineSearch *linesearch,char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
39 {
40   const char *tname;
41 
42   *ierr = SNESLineSearchGetType(*linesearch,&tname);
43   *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
44   FIXRETURNCHAR(PETSC_TRUE,name,len);
45 }
46 
47 PETSC_EXTERN void sneslinesearchsettype_(SNESLineSearch *linesearch,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
48 {
49   char *t;
50 
51   FIXCHAR(type,len,t);
52   *ierr = SNESLineSearchSetType(*linesearch,t);if (*ierr) return;
53   FREECHAR(type,t);
54 }
55 
56 
57 PETSC_EXTERN void sneslinesearchsetprecheck_(SNESLineSearch *linesearch,void (*func)(SNESLineSearch*,Vec*,Vec*,PetscBool*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
58 {
59   PetscObjectAllocateFortranPointers(*linesearch,3);
60   ((PetscObject)*linesearch)->fortran_func_pointers[1] = (PetscVoidFunction)func;
61 
62   *ierr = SNESLineSearchSetPreCheck(*linesearch,oursneslinesearchprecheck,ctx);
63 }
64 
65 PETSC_EXTERN void sneslinesearchsetpostcheck_(SNESLineSearch *linesearch,void (*func)(SNESLineSearch*,Vec*,Vec*,Vec*,PetscBool*,PetscBool*,PetscErrorCode*,void*),void *ctx,PetscErrorCode *ierr)
66 {
67   PetscObjectAllocateFortranPointers(*linesearch,3);
68   ((PetscObject)*linesearch)->fortran_func_pointers[2] = (PetscVoidFunction)func;
69 
70   *ierr = SNESLineSearchSetPostCheck(*linesearch,oursneslinesearchpostcheck,ctx);
71 }
72 
73