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
ourhandler(PetscObject obj,PetscOptionItems items,PetscCtx ctx)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
ourdestroy(PetscObject obj,PetscCtx ctx)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
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))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