16dd63270SBarry Smith #include <petsc/private/ftnimpl.h>
2af0996ceSBarry Smith #include <petsc/private/snesimpl.h>
3382167b7SJed Brown #if defined(PETSC_HAVE_FORTRAN_CAPS)
4382167b7SJed Brown #define dmsnessetjacobian_ DMSNESSETJACOBIAN
5382167b7SJed Brown #define dmsnessetfunction_ DMSNESSETFUNCTION
6382167b7SJed Brown #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
7382167b7SJed Brown #define dmsnessetjacobian_ dmsnessetjacobian
8382167b7SJed Brown #define dmsnessetfunction_ dmsnessetfunction
9382167b7SJed Brown #endif
10382167b7SJed Brown
11382167b7SJed Brown static struct {
12382167b7SJed Brown PetscFortranCallbackId snesfunction;
13382167b7SJed Brown PetscFortranCallbackId snesjacobian;
14382167b7SJed Brown } _cb;
15382167b7SJed Brown
ourj(SNES snes,Vec X,Mat J,Mat P,void * ptr)16d1e9a80fSBarry Smith static PetscErrorCode ourj(SNES snes, Vec X, Mat J, Mat P, void *ptr)
17382167b7SJed Brown {
1819caf8f3SSatish Balay void (*func)(SNES *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), *ctx;
19382167b7SJed Brown DM dm;
20382167b7SJed Brown DMSNES sdm;
21382167b7SJed Brown
22382167b7SJed Brown PetscFunctionBegin;
239566063dSJacob Faibussowitsch PetscCall(SNESGetDM(snes, &dm));
249566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm));
255ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.snesjacobian, (PetscFortranCallbackFn **)&func, &ctx));
269566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&snes, &X, &J, &P, ctx, &ierr));
273ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS);
28382167b7SJed Brown }
29382167b7SJed Brown
dmsnessetjacobian_(DM * dm,void (* jac)(DM *,Vec *,Mat *,Mat *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)30*2a8381b2SBarry Smith PETSC_EXTERN void dmsnessetjacobian_(DM *dm, void (*jac)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
31382167b7SJed Brown {
32382167b7SJed Brown DMSNES sdm;
33382167b7SJed Brown
345975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm);
355975b3b6SBarry Smith if (*ierr) return;
365ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.snesjacobian, (PetscFortranCallbackFn *)jac, ctx);
375975b3b6SBarry Smith if (*ierr) return;
38382167b7SJed Brown *ierr = DMSNESSetJacobian(*dm, ourj, NULL);
39382167b7SJed Brown }
40382167b7SJed Brown
ourf(SNES snes,Vec X,Vec F,void * ptr)41382167b7SJed Brown static PetscErrorCode ourf(SNES snes, Vec X, Vec F, void *ptr)
42382167b7SJed Brown {
4319caf8f3SSatish Balay void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), *ctx;
44382167b7SJed Brown DM dm;
45382167b7SJed Brown DMSNES sdm;
46382167b7SJed Brown
47382167b7SJed Brown PetscFunctionBegin;
489566063dSJacob Faibussowitsch PetscCall(SNESGetDM(snes, &dm));
499566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(dm, &sdm));
505ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.snesfunction, (PetscFortranCallbackFn **)&func, &ctx));
519566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(&snes, &X, &F, ctx, &ierr));
523ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS);
53382167b7SJed Brown }
54382167b7SJed Brown
dmsnessetfunction_(DM * dm,void (* func)(SNES *,Vec *,Vec *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)55*2a8381b2SBarry Smith PETSC_EXTERN void dmsnessetfunction_(DM *dm, void (*func)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
56382167b7SJed Brown {
57382167b7SJed Brown DMSNES sdm;
58382167b7SJed Brown
595975b3b6SBarry Smith *ierr = DMGetDMSNESWrite(*dm, &sdm);
605975b3b6SBarry Smith if (*ierr) return;
615ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.snesfunction, (PetscFortranCallbackFn *)func, ctx);
625975b3b6SBarry Smith if (*ierr) return;
63382167b7SJed Brown *ierr = DMSNESSetFunction(*dm, ourf, NULL);
64382167b7SJed Brown }
65