xref: /petsc/src/tao/leastsquares/impls/brgn/ftn-custom/zbrgnf.c (revision 463fc0ec94f64484067146917d957227df881da2)
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)
6*463fc0ecSAlp Dener #define taobrgnsetregularizerobjectiveandgradientroutine_ TAOBRGNSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE
7*463fc0ecSAlp Dener #define taobrgnsetregularizerhessianroutine_              TAOBRGNSETREGULARIZERHESSIANROUTINE
8e1e80dc8SAlp Dener #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9*463fc0ecSAlp Dener #define taobrgnsetregularizerobjectiveandgradientroutine_ taobrgnsetregularizerobjectiveandgradientroutine
10*463fc0ecSAlp Dener #define taobrgnsetregularizerhessianroutine_              taobrgnsetregularizerhessianroutine
11e1e80dc8SAlp Dener #endif
12e1e80dc8SAlp Dener 
13*463fc0ecSAlp Dener static struct {
14*463fc0ecSAlp Dener   PetscFortranCallbackId objgrad;
15*463fc0ecSAlp Dener   PetscFortranCallbackId hess;
16*463fc0ecSAlp Dener } _cb;
17*463fc0ecSAlp Dener 
18*463fc0ecSAlp Dener static PetscErrorCode ourtaobrgnregobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void* ctx)
19e1e80dc8SAlp Dener {
20*463fc0ecSAlp Dener     PetscObjectUseFortranCallback(tao,_cb.objgrad,(Tao*,Vec*,PetscReal*,Vec*,void*,PetscErrorCode*),(&tao,&x,f,&g,_ctx,&ierr));
21e1e80dc8SAlp Dener }
22e1e80dc8SAlp Dener 
23*463fc0ecSAlp Dener static PetscErrorCode ourtaobrgnreghessroutine(Tao tao, Vec x, Mat H, void *ctx)
24e1e80dc8SAlp Dener {
25*463fc0ecSAlp Dener     PetscObjectUseFortranCallback(tao,_cb.hess,(Tao*,Vec*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,_ctx,&ierr));
26e1e80dc8SAlp Dener }
278ac80d48SXiang Huang 
28*463fc0ecSAlp Dener EXTERN_C_BEGIN
29*463fc0ecSAlp Dener 
30*463fc0ecSAlp Dener PETSC_EXTERN void PETSC_STDCALL taobrgnsetregularizerobjectiveandgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
318ac80d48SXiang Huang {
32*463fc0ecSAlp Dener     CHKFORTRANNULLFUNCTION(func);
33*463fc0ecSAlp Dener     *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.objgrad,(PetscVoidFunction)func,ctx);
34*463fc0ecSAlp Dener     if(!*ierr) *ierr = TaoBRGNSetRegularizerObjectiveAndGradientRoutine(*tao,ourtaobrgnregobjgradroutine,ctx);
358ac80d48SXiang Huang }
368ac80d48SXiang Huang 
37*463fc0ecSAlp Dener PETSC_EXTERN void PETSC_STDCALL taobrgnsetregularizerhessianroutine_(Tao *tao, Mat *H, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
388e85b1b3SXiang Huang {
39*463fc0ecSAlp Dener     CHKFORTRANNULLFUNCTION(func);
40*463fc0ecSAlp Dener     *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.hess,(PetscVoidFunction)func,ctx);
41*463fc0ecSAlp Dener     if(!*ierr) *ierr = TaoBRGNSetRegularizerHessianRoutine(*tao,*H, ourtaobrgnreghessroutine,ctx);
428e85b1b3SXiang Huang }
43