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: }