xref: /petsc/src/sys/objects/ftn-custom/zinheritf.c (revision 4e8208cbcbc709572b8abe32f33c78b69c819375)
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 
ourhandler(PetscObject obj,PetscOptionItems items,PetscCtx ctx)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 
ourdestroy(PetscObject obj,PetscCtx ctx)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 
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*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