Actual source code: zbrgnf.c

  1: #include <petsc/private/ftnimpl.h>
  2: #include <petsc/private/taoimpl.h>

  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

 12: static struct {
 13:   PetscFortranCallbackId objgrad;
 14:   PetscFortranCallbackId hess;
 15: } _cb;

 17: static PetscErrorCode ourtaobrgnregobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
 18: {
 19:   PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
 20: }

 22: static PetscErrorCode ourtaobrgnreghessroutine(Tao tao, Vec x, Mat H, void *ctx)
 23: {
 24:   PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
 25: }

 27: PETSC_EXTERN void taobrgnsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 28: {
 29:   CHKFORTRANNULLFUNCTION(func);
 30:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscVoidFn *)func, ctx);
 31:   if (!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaobrgnregobjgradroutine, ctx);
 32: }

 34: PETSC_EXTERN void taobrgnsetregularizerhessianroutine_(Tao *tao, Mat *H, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 35: {
 36:   CHKFORTRANNULLFUNCTION(func);
 37:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscVoidFn *)func, ctx);
 38:   if (!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao, *H, ourtaobrgnreghessroutine, ctx);
 39: }