16dd63270SBarry Smith #include <petsc/private/ftnimpl.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
oursnesshellsolve(SNES snes,Vec x)1090b77ac2SPeter Brune static PetscErrorCode oursnesshellsolve(SNES snes, Vec x)
1190b77ac2SPeter Brune {
1219caf8f3SSatish Balay void (*func)(SNES *, Vec *, PetscErrorCode *);
139566063dSJacob Faibussowitsch PetscCall(PetscObjectQueryFunction((PetscObject)snes, "SNESShellSolve_C", &func));
145f80ce2aSJacob Faibussowitsch PetscCheck(func, PetscObjectComm((PetscObject)snes), PETSC_ERR_USER, "SNESShellSetSolve() must be called before SNESSolve()");
159566063dSJacob Faibussowitsch PetscCallFortranVoidFunction(func(&snes, &x, &ierr));
163ba16761SJacob Faibussowitsch return PETSC_SUCCESS;
1790b77ac2SPeter Brune }
18158f039cSPeter Brune
snesshellsetsolve_(SNES * snes,void (* func)(SNES *,Vec *,PetscErrorCode *),PetscErrorCode * ierr)1919caf8f3SSatish Balay PETSC_EXTERN void snesshellsetsolve_(SNES *snes, void (*func)(SNES *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
2090b77ac2SPeter Brune {
21*57d50842SBarry Smith *ierr = PetscObjectComposeFunction((PetscObject)*snes, "SNESShellSolve_C", (PetscErrorCodeFn *)func);
223ba16761SJacob Faibussowitsch if (*ierr) return;
2390b77ac2SPeter Brune *ierr = SNESShellSetSolve(*snes, oursnesshellsolve);
2490b77ac2SPeter Brune }
25