16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2e1e80dc8SAlp Dener #include <petsc/private/taoimpl.h> 3e1e80dc8SAlp Dener 4e1e80dc8SAlp Dener #if defined(PETSC_HAVE_FORTRAN_CAPS) 5463fc0ecSAlp Dener #define taobrgnsetregularizerobjectiveandgradientroutine_ TAOBRGNSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE 6463fc0ecSAlp Dener #define taobrgnsetregularizerhessianroutine_ TAOBRGNSETREGULARIZERHESSIANROUTINE 7e1e80dc8SAlp Dener #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8463fc0ecSAlp Dener #define taobrgnsetregularizerobjectiveandgradientroutine_ taobrgnsetregularizerobjectiveandgradientroutine 9463fc0ecSAlp Dener #define taobrgnsetregularizerhessianroutine_ taobrgnsetregularizerhessianroutine 10e1e80dc8SAlp Dener #endif 11e1e80dc8SAlp Dener 12463fc0ecSAlp Dener static struct { 13463fc0ecSAlp Dener PetscFortranCallbackId objgrad; 14463fc0ecSAlp Dener PetscFortranCallbackId hess; 15463fc0ecSAlp Dener } _cb; 16463fc0ecSAlp Dener 17*2a8381b2SBarry Smith static PetscErrorCode ourtaobrgnregobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, PetscCtx ctx) 18e1e80dc8SAlp Dener { 19463fc0ecSAlp Dener PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr)); 20e1e80dc8SAlp Dener } 21e1e80dc8SAlp Dener 22*2a8381b2SBarry Smith static PetscErrorCode ourtaobrgnreghessroutine(Tao tao, Vec x, Mat H, PetscCtx ctx) 23e1e80dc8SAlp Dener { 24463fc0ecSAlp Dener PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr)); 25e1e80dc8SAlp Dener } 268ac80d48SXiang Huang 27*2a8381b2SBarry Smith PETSC_EXTERN void taobrgnsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr) 288ac80d48SXiang Huang { 29463fc0ecSAlp Dener CHKFORTRANNULLFUNCTION(func); 305ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscFortranCallbackFn *)func, ctx); 31463fc0ecSAlp Dener if (!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaobrgnregobjgradroutine, ctx); 328ac80d48SXiang Huang } 338ac80d48SXiang Huang 34*2a8381b2SBarry Smith PETSC_EXTERN void taobrgnsetregularizerhessianroutine_(Tao *tao, Mat *H, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr) 358e85b1b3SXiang Huang { 36463fc0ecSAlp Dener CHKFORTRANNULLFUNCTION(func); 375ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscFortranCallbackFn *)func, ctx); 38463fc0ecSAlp Dener if (!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao, *H, ourtaobrgnreghessroutine, ctx); 398e85b1b3SXiang Huang } 40