xref: /petsc/src/tao/leastsquares/impls/brgn/ftn-custom/zbrgnf.c (revision 8434afd195968570cfdb5bc7b9cfc0a316d974ae)
1e1e80dc8SAlp Dener #include <petsc/private/fortranimpl.h>
2e1e80dc8SAlp Dener #include <petsc/private/f90impl.h>
3e1e80dc8SAlp Dener #include <petsc/private/taoimpl.h>
4e1e80dc8SAlp Dener 
5e1e80dc8SAlp Dener #if defined(PETSC_HAVE_FORTRAN_CAPS)
6463fc0ecSAlp Dener   #define taobrgnsetregularizerobjectiveandgradientroutine_ TAOBRGNSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE
7463fc0ecSAlp Dener   #define taobrgnsetregularizerhessianroutine_              TAOBRGNSETREGULARIZERHESSIANROUTINE
8e1e80dc8SAlp Dener #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9463fc0ecSAlp Dener   #define taobrgnsetregularizerobjectiveandgradientroutine_ taobrgnsetregularizerobjectiveandgradientroutine
10463fc0ecSAlp Dener   #define taobrgnsetregularizerhessianroutine_              taobrgnsetregularizerhessianroutine
11e1e80dc8SAlp Dener #endif
12e1e80dc8SAlp Dener 
13463fc0ecSAlp Dener static struct {
14463fc0ecSAlp Dener   PetscFortranCallbackId objgrad;
15463fc0ecSAlp Dener   PetscFortranCallbackId hess;
16463fc0ecSAlp Dener } _cb;
17463fc0ecSAlp Dener 
18463fc0ecSAlp Dener static PetscErrorCode ourtaobrgnregobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
19e1e80dc8SAlp Dener {
20463fc0ecSAlp Dener   PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
21e1e80dc8SAlp Dener }
22e1e80dc8SAlp Dener 
23463fc0ecSAlp Dener static PetscErrorCode ourtaobrgnreghessroutine(Tao tao, Vec x, Mat H, void *ctx)
24e1e80dc8SAlp Dener {
25463fc0ecSAlp Dener   PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
26e1e80dc8SAlp Dener }
278ac80d48SXiang Huang 
2819caf8f3SSatish Balay PETSC_EXTERN void taobrgnsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
298ac80d48SXiang Huang {
30463fc0ecSAlp Dener   CHKFORTRANNULLFUNCTION(func);
31*8434afd1SBarry Smith   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscVoidFn *)func, ctx);
32463fc0ecSAlp Dener   if (!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaobrgnregobjgradroutine, ctx);
338ac80d48SXiang Huang }
348ac80d48SXiang Huang 
3519caf8f3SSatish Balay PETSC_EXTERN void taobrgnsetregularizerhessianroutine_(Tao *tao, Mat *H, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
368e85b1b3SXiang Huang {
37463fc0ecSAlp Dener   CHKFORTRANNULLFUNCTION(func);
38*8434afd1SBarry Smith   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscVoidFn *)func, ctx);
39463fc0ecSAlp Dener   if (!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao, *H, ourtaobrgnreghessroutine, ctx);
408e85b1b3SXiang Huang }
41