Actual source code: zdmlocalsnesf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petsc/private/snesimpl.h>
3: #if defined(PETSC_HAVE_FORTRAN_CAPS)
4: #define dmsnessetjacobianlocal_ DMSNESSETJACOBIANLOCAL
5: #define dmsnessetfunctionlocal_ DMSNESSETFUNCTIONLOCAL
6: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
7: #define dmsnessetjacobianlocal_ dmsnessetjacobianlocal
8: #define dmsnessetfunctionlocal_ dmsnessetfunctionlocal
9: #endif
11: static struct {
12: PetscFortranCallbackId lf;
13: PetscFortranCallbackId lj;
14: } _cb;
16: static PetscErrorCode sourlj(DM dm, Vec X, Mat J, Mat P, void *ptr)
17: {
18: void (*func)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), *ctx;
19: DMSNES sdm;
21: PetscFunctionBegin;
22: PetscCall(DMGetDMSNES(dm, &sdm));
23: PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj, (PetscVoidFn **)&func, &ctx));
24: PetscCallFortranVoidFunction((*func)(&dm, &X, &J, &P, ctx, &ierr));
25: PetscFunctionReturn(PETSC_SUCCESS);
26: }
28: PETSC_EXTERN void dmsnessetjacobianlocal_(DM *dm, void (*jac)(DM *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
29: {
30: DMSNES sdm;
32: *ierr = DMGetDMSNESWrite(*dm, &sdm);
33: if (*ierr) return;
34: *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj, (PetscVoidFn *)jac, ctx);
35: if (*ierr) return;
36: *ierr = DMSNESSetJacobianLocal(*dm, sourlj, NULL);
37: }
39: static PetscErrorCode sourlf(DM dm, Vec X, Vec F, void *ptr)
40: {
41: void (*func)(DM *, Vec *, Vec *, void *, PetscErrorCode *), *ctx;
42: DMSNES sdm;
44: PetscFunctionBegin;
45: PetscCall(DMGetDMSNES(dm, &sdm));
46: PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf, (PetscVoidFn **)&func, &ctx));
47: PetscCallFortranVoidFunction((*func)(&dm, &X, &F, ctx, &ierr));
48: PetscFunctionReturn(PETSC_SUCCESS);
49: }
51: PETSC_EXTERN void dmsnessetfunctionlocal_(DM *dm, void (*func)(DM *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
52: {
53: DMSNES sdm;
55: *ierr = DMGetDMSNESWrite(*dm, &sdm);
56: if (*ierr) return;
57: *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf, (PetscVoidFn *)func, ctx);
58: if (*ierr) return;
59: *ierr = DMSNESSetFunctionLocal(*dm, sourlf, NULL);
60: }