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 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 } 21 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 } 26 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, (PetscFortranCallbackFn *)func, ctx); 31 if (!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaobrgnregobjgradroutine, ctx); 32 } 33 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, (PetscFortranCallbackFn *)func, ctx); 38 if (!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao, *H, ourtaobrgnreghessroutine, ctx); 39 } 40