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 PetscFunctionBegin; 26 PetscCallFortranVoidFunction((*(void (*)(SNESLineSearch *, Vec *, Vec *, PetscBool *, void *, PetscErrorCode *))(((PetscObject)linesearch)->fortran_func_pointers[1]))(&linesearch, &X, &Y, changed, ctx, &ierr)); 27 PetscFunctionReturn(PETSC_SUCCESS); 28 } 29 30 static PetscErrorCode oursneslinesearchpostcheck(SNESLineSearch linesearch, Vec X, Vec Y, Vec W, PetscBool *changed_Y, PetscBool *changed_W, void *ctx) 31 { 32 PetscFunctionBegin; 33 PetscCallFortranVoidFunction((*(void (*)(SNESLineSearch *, Vec *, Vec *, Vec *, PetscBool *, PetscBool *, void *, PetscErrorCode *))(((PetscObject)linesearch)->fortran_func_pointers[2]))(&linesearch, &X, &Y, &W, changed_Y, changed_W, ctx, &ierr)); 34 PetscFunctionReturn(PETSC_SUCCESS); 35 } 36 37 PETSC_EXTERN void sneslinesearchgettype_(SNESLineSearch *linesearch, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 38 { 39 const char *tname; 40 41 *ierr = SNESLineSearchGetType(*linesearch, &tname); 42 *ierr = PetscStrncpy(name, tname, len); 43 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); 53 if (*ierr) return; 54 FREECHAR(type, t); 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] = (PetscVoidFn *)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] = (PetscVoidFn *)func; 69 70 *ierr = SNESLineSearchSetPostCheck(*linesearch, oursneslinesearchpostcheck, ctx); 71 } 72