1: #include "petscsys.h"
  2: #include "petscfix.h"
  3: #include "petsc/private/ftnimpl.h"
  4: #include <petscsys.h>
  5: #include <petscoptions.h>
  6: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  7:   #define petscobjectaddoptionshandler_ PETSCOBJECTADDOPTIONSHANDLER
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define petscobjectaddoptionshandler_ petscobjectaddoptionshandler
 10: #endif

 12: static struct {
 13:   PetscFortranCallbackId handler;
 14:   PetscFortranCallbackId destroy;
 15: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 16:   PetscFortranCallbackId handler_pgiptr;
 17:   PetscFortranCallbackId destroy_pgiptr;
 18: #endif
 19: } _cb;

 21: static PetscErrorCode ourhandler(PetscObject obj, PetscOptionItems items, PetscCtx ctx)
 22: {
 23: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 24:   void *ptr;
 25:   PetscCall(PetscObjectGetFortranCallback((PetscObject)obj, PETSC_FORTRAN_CALLBACK_CLASS, _cb.handler_pgiptr, NULL, &ptr));
 26: #endif
 27:   PetscObjectUseFortranCallback(obj, _cb.handler, (PetscObject *, PetscOptionItems *, PetscCtx, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&obj, &items, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
 28: }

 30: static PetscErrorCode ourdestroy(PetscObject obj, PetscCtx ctx)
 31: {
 32: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 33:   void *ptr;
 34:   PetscCall(PetscObjectGetFortranCallback((PetscObject)obj, PETSC_FORTRAN_CALLBACK_CLASS, _cb.destroy_pgiptr, NULL, &ptr));
 35: #endif
 36:   PetscObjectUseFortranCallback(obj, _cb.destroy, (PetscObject *, PetscCtx, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&obj, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr)));
 37: }

 39: PETSC_EXTERN void petscobjectaddoptionshandler_(PetscObject *obj, void (*handle)(PetscObject *, PetscOptionItems *, PetscCtx, PetscErrorCode), void (*destroy)(PetscObject *, PetscCtx, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr1) PETSC_F90_2PTR_PROTO(ptr2))
 40: {
 41:   *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.handler, (PetscFortranCallbackFn *)handle, ctx);
 42:   if (*ierr) return;
 43: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 44:   *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.handler_pgiptr, NULL, ptr1);
 45:   if (*ierr) return;
 46: #endif
 47:   *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscFortranCallbackFn *)destroy, ctx);
 48:   if (*ierr) return;
 49: #if defined(PETSC_HAVE_F90_2PTR_ARG)
 50:   *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy_pgiptr, NULL, ptr2);
 51:   if (*ierr) return;
 52: #endif
 53:   *ierr = PetscObjectAddOptionsHandler(*obj, ourhandler, ourdestroy, NULL);
 54: }