Actual source code: zdmlocalsnesf.c

      1: #include <petsc/private/ftnimpl.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, (PetscFortranCallbackFn **)&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, (PetscFortranCallbackFn *)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, (PetscFortranCallbackFn **)&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, (PetscFortranCallbackFn *)func, ctx);
     58:   if (*ierr) return;
     59:   *ierr = DMSNESSetFunctionLocal(*dm, sourlf, NULL);
     60: }