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 11 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; 20 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 } 29 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 } 38 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 } 55