1*2a8381b2SBarry Smith #include "petscsys.h" 2*2a8381b2SBarry Smith #include "petscfix.h" 3*2a8381b2SBarry Smith #include "petsc/private/ftnimpl.h" 4*2a8381b2SBarry Smith #include <petscsys.h> 5*2a8381b2SBarry Smith #include <petscoptions.h> 6*2a8381b2SBarry Smith #if defined(PETSC_HAVE_FORTRAN_CAPS) 7*2a8381b2SBarry Smith #define petscobjectaddoptionshandler_ PETSCOBJECTADDOPTIONSHANDLER 8*2a8381b2SBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9*2a8381b2SBarry Smith #define petscobjectaddoptionshandler_ petscobjectaddoptionshandler 10*2a8381b2SBarry Smith #endif 11*2a8381b2SBarry Smith 12*2a8381b2SBarry Smith static struct { 13*2a8381b2SBarry Smith PetscFortranCallbackId handler; 14*2a8381b2SBarry Smith PetscFortranCallbackId destroy; 15*2a8381b2SBarry Smith #if defined(PETSC_HAVE_F90_2PTR_ARG) 16*2a8381b2SBarry Smith PetscFortranCallbackId handler_pgiptr; 17*2a8381b2SBarry Smith PetscFortranCallbackId destroy_pgiptr; 18*2a8381b2SBarry Smith #endif 19*2a8381b2SBarry Smith } _cb; 20*2a8381b2SBarry Smith 21*2a8381b2SBarry Smith static PetscErrorCode ourhandler(PetscObject obj, PetscOptionItems items, PetscCtx ctx) 22*2a8381b2SBarry Smith { 23*2a8381b2SBarry Smith #if defined(PETSC_HAVE_F90_2PTR_ARG) 24*2a8381b2SBarry Smith void *ptr; 25*2a8381b2SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)obj, PETSC_FORTRAN_CALLBACK_CLASS, _cb.handler_pgiptr, NULL, &ptr)); 26*2a8381b2SBarry Smith #endif 27*2a8381b2SBarry Smith PetscObjectUseFortranCallback(obj, _cb.handler, (PetscObject *, PetscOptionItems *, PetscCtx, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&obj, &items, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr))); 28*2a8381b2SBarry Smith } 29*2a8381b2SBarry Smith 30*2a8381b2SBarry Smith static PetscErrorCode ourdestroy(PetscObject obj, PetscCtx ctx) 31*2a8381b2SBarry Smith { 32*2a8381b2SBarry Smith #if defined(PETSC_HAVE_F90_2PTR_ARG) 33*2a8381b2SBarry Smith void *ptr; 34*2a8381b2SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)obj, PETSC_FORTRAN_CALLBACK_CLASS, _cb.destroy_pgiptr, NULL, &ptr)); 35*2a8381b2SBarry Smith #endif 36*2a8381b2SBarry Smith PetscObjectUseFortranCallback(obj, _cb.destroy, (PetscObject *, PetscCtx, PetscErrorCode *PETSC_F90_2PTR_PROTO_NOVAR), (&obj, _ctx, &ierr PETSC_F90_2PTR_PARAM(ptr))); 37*2a8381b2SBarry Smith } 38*2a8381b2SBarry Smith 39*2a8381b2SBarry Smith 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*2a8381b2SBarry Smith { 41*2a8381b2SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.handler, (PetscFortranCallbackFn *)handle, ctx); 42*2a8381b2SBarry Smith if (*ierr) return; 43*2a8381b2SBarry Smith #if defined(PETSC_HAVE_F90_2PTR_ARG) 44*2a8381b2SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.handler_pgiptr, NULL, ptr1); 45*2a8381b2SBarry Smith if (*ierr) return; 46*2a8381b2SBarry Smith #endif 47*2a8381b2SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy, (PetscFortranCallbackFn *)destroy, ctx); 48*2a8381b2SBarry Smith if (*ierr) return; 49*2a8381b2SBarry Smith #if defined(PETSC_HAVE_F90_2PTR_ARG) 50*2a8381b2SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*obj, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.destroy_pgiptr, NULL, ptr2); 51*2a8381b2SBarry Smith if (*ierr) return; 52*2a8381b2SBarry Smith #endif 53*2a8381b2SBarry Smith *ierr = PetscObjectAddOptionsHandler(*obj, ourhandler, ourdestroy, NULL); 54*2a8381b2SBarry Smith } 55