xref: /petsc/src/snes/impls/shell/ftn-custom/zsnesshellf.c (revision 2286efddd54511ab18e8e2adb1e023c4bf8f0b92)
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