190b77ac2SPeter Brune #include <petsc-private/fortranimpl.h> 290b77ac2SPeter Brune #include <petscsnes.h> 390b77ac2SPeter Brune 490b77ac2SPeter Brune #if defined(PETSC_HAVE_FORTRAN_CAPS) 590b77ac2SPeter Brune #define snesshellsetsolve_ SNESSHELLSETSOLVE 690b77ac2SPeter Brune #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 790b77ac2SPeter Brune #define snesshellsetsolve_ snesshellsetsolve 890b77ac2SPeter Brune #endif 990b77ac2SPeter Brune 1090b77ac2SPeter Brune static PetscErrorCode oursnesshellsolve(SNES snes,Vec x) 1190b77ac2SPeter Brune { 1290b77ac2SPeter Brune PetscErrorCode ierr = 0; 13158f039cSPeter Brune void (PETSC_STDCALL *func)(SNES*,Vec*,PetscErrorCode*); 14158f039cSPeter Brune ierr = PetscObjectQueryFunction((PetscObject)snes,"SNESShellSolve_C",(PetscVoidFunction*)&func);CHKERRQ(ierr); 15*ce94432eSBarry Smith if (!func) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_USER,"SNESShellSetSolve() must be called before SNESSolve()"); 16158f039cSPeter Brune func(&snes,&x,&ierr);CHKERRQ(ierr); 1790b77ac2SPeter Brune return 0; 1890b77ac2SPeter Brune } 19158f039cSPeter Brune 20158f039cSPeter Brune EXTERN_C_BEGIN 2190b77ac2SPeter Brune void PETSC_STDCALL snesshellsetsolve_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 2290b77ac2SPeter Brune { 230298fd71SBarry Smith PetscObjectComposeFunctionDynamic((PetscObject)*snes,"SNESShellSolve_C",NULL,(PetscVoidFunction)func); 2490b77ac2SPeter Brune *ierr = SNESShellSetSolve(*snes,oursnesshellsolve); 2590b77ac2SPeter Brune } 26158f039cSPeter Brune EXTERN_C_END 27