1 #include <petsc/private/ftnimpl.h>
2 #include <petsc/private/taoimpl.h>
3
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define taobrgnsetregularizerobjectiveandgradientroutine_ TAOBRGNSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE
6 #define taobrgnsetregularizerhessianroutine_ TAOBRGNSETREGULARIZERHESSIANROUTINE
7 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
8 #define taobrgnsetregularizerobjectiveandgradientroutine_ taobrgnsetregularizerobjectiveandgradientroutine
9 #define taobrgnsetregularizerhessianroutine_ taobrgnsetregularizerhessianroutine
10 #endif
11
12 static struct {
13 PetscFortranCallbackId objgrad;
14 PetscFortranCallbackId hess;
15 } _cb;
16
ourtaobrgnregobjgradroutine(Tao tao,Vec x,PetscReal * f,Vec g,PetscCtx ctx)17 static PetscErrorCode ourtaobrgnregobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, PetscCtx ctx)
18 {
19 PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
20 }
21
ourtaobrgnreghessroutine(Tao tao,Vec x,Mat H,PetscCtx ctx)22 static PetscErrorCode ourtaobrgnreghessroutine(Tao tao, Vec x, Mat H, PetscCtx ctx)
23 {
24 PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
25 }
26
taobrgnsetregularizerobjectiveandgradientroutine_(Tao * tao,void (* func)(Tao *,Vec *,PetscReal *,Vec *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)27 PETSC_EXTERN void taobrgnsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
28 {
29 CHKFORTRANNULLFUNCTION(func);
30 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscFortranCallbackFn *)func, ctx);
31 if (!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaobrgnregobjgradroutine, ctx);
32 }
33
taobrgnsetregularizerhessianroutine_(Tao * tao,Mat * H,void (* func)(Tao *,Vec *,Mat *,void *,PetscErrorCode *),PetscCtx ctx,PetscErrorCode * ierr)34 PETSC_EXTERN void taobrgnsetregularizerhessianroutine_(Tao *tao, Mat *H, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
35 {
36 CHKFORTRANNULLFUNCTION(func);
37 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscFortranCallbackFn *)func, ctx);
38 if (!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao, *H, ourtaobrgnreghessroutine, ctx);
39 }
40