1 #include <petsc-private/fortranimpl.h> 2 #include <petscsnes.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define snesshellsetsolve_ SNESSHELLSETSOLVE 6 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 7 #define snesshellsetsolve_ snesshellsetsolve 8 #endif 9 10 static PetscErrorCode oursnesshellsolve(SNES snes,Vec x) 11 { 12 PetscErrorCode ierr = 0; 13 void (PETSC_STDCALL *func)(SNES*,Vec*,PetscErrorCode*); 14 ierr = PetscObjectQueryFunction((PetscObject)snes,"SNESShellSolve_C",(PetscVoidFunction*)&func);CHKERRQ(ierr); 15 if (!func) SETERRQ(((PetscObject)snes)->comm,PETSC_ERR_USER,"SNESShellSetSolve() must be called before SNESSolve()"); 16 func(&snes,&x,&ierr);CHKERRQ(ierr); 17 return 0; 18 } 19 20 EXTERN_C_BEGIN 21 void PETSC_STDCALL snesshellsetsolve_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 22 { 23 PetscObjectComposeFunctionDynamic((PetscObject)*snes,"SNESShellSolve_C",NULL,(PetscVoidFunction)func); 24 *ierr = SNESShellSetSolve(*snes,oursnesshellsolve); 25 } 26 EXTERN_C_END 27