Actual source code: zadmmf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petsc/private/f90impl.h>
3: #include <petsc/private/taoimpl.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define taoadmmsetmisfitobjectiveandgradientroutine_ TAOADMMSETMISFITOBJECTIVEANDGRADIENTROUTINE
7: #define taoadmmsetmisfithessianroutine_ TAOADMMSETMISFITHESSIANROUTINE
8: #define taoadmmsetmisfitconstraintjacobian_ TAOADMMSETMISFITCONSTRAINTJACOBIAN
9: #define taoadmmsetregularizerobjectiveandgradientroutine_ TAOADMMSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE
10: #define taoadmmsetregularizerhessianroutine_ TAOADMMSETREGULARIZERHESSIANROUTINE
11: #define taoadmmsetregularizerconstraintjacobian_ TAOADMMSETREGULARIZERCONSTRAINTJACOBIAN
12: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
13: #define taoadmmsetmisfitobjectiveandgradientroutine_ taoadmmsetmisfitobjectiveandgradientroutine
14: #define taoadmmsetmisfithessianroutine_ taoadmmsetmisfithessianroutine
15: #define taoadmmsetmisfitconstraintjacobian_ taoadmmsetmisfitconstraintjacobian
16: #define taoadmmsetregularizerobjectiveandgradientroutine_ taoadmmsetregularizerobjectiveandgradientroutine
17: #define taoadmmsetregularizerhessianroutine_ taoadmmsetregularizerhessianroutine
18: #define taoadmmsetregularizerconstraintjacobian_ taoadmmsetregularizerconstraintjacobian
19: #endif
21: static struct {
22: PetscFortranCallbackId misfitobjgrad;
23: PetscFortranCallbackId misfithess;
24: PetscFortranCallbackId misfitjacobian;
25: PetscFortranCallbackId regobjgrad;
26: PetscFortranCallbackId reghess;
27: PetscFortranCallbackId regjacobian;
28: } _cb;
30: static PetscErrorCode ourtaoadmmmisfitobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
31: {
32: PetscObjectUseFortranCallback(tao, _cb.misfitobjgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
33: }
35: static PetscErrorCode ourtaoadmmmisfithessroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
36: {
37: PetscObjectUseFortranCallback(tao, _cb.misfithess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
38: }
40: static PetscErrorCode ourtaoadmmmisfitconstraintjacobian(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
41: {
42: PetscObjectUseFortranCallback(tao, _cb.misfitjacobian, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
43: }
45: static PetscErrorCode ourtaoadmmregularizerobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
46: {
47: PetscObjectUseFortranCallback(tao, _cb.regobjgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
48: }
50: static PetscErrorCode ourtaoadmmregularizerhessroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
51: {
52: PetscObjectUseFortranCallback(tao, _cb.reghess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
53: }
55: static PetscErrorCode ourtaoadmmregularizerconstraintjacobian(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
56: {
57: PetscObjectUseFortranCallback(tao, _cb.regjacobian, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
58: }
60: PETSC_EXTERN void taoadmmsetmisfitobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
61: {
62: CHKFORTRANNULLFUNCTION(func);
63: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitobjgrad, (PetscVoidFn *)func, ctx);
64: if (!*ierr) *ierr = TaoADMMSetMisfitObjectiveAndGradientRoutine(*tao, ourtaoadmmmisfitobjgradroutine, ctx);
65: }
67: PETSC_EXTERN void taoadmmsetmisfithessianroutine_(Tao *tao, Mat *H, Mat *Hpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
68: {
69: CHKFORTRANNULLFUNCTION(func);
70: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfithess, (PetscVoidFn *)func, ctx);
71: if (!*ierr) *ierr = TaoADMMSetMisfitHessianRoutine(*tao, *H, *Hpre, ourtaoadmmmisfithessroutine, ctx);
72: }
74: PETSC_EXTERN void taoadmmsetmisfitconstraintjacobian_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
75: {
76: CHKFORTRANNULLFUNCTION(func);
77: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitjacobian, (PetscVoidFn *)func, ctx);
78: if (!*ierr) *ierr = TaoADMMSetMisfitConstraintJacobian(*tao, *J, *Jpre, ourtaoadmmmisfitconstraintjacobian, ctx);
79: }
81: PETSC_EXTERN void taoadmmsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
82: {
83: CHKFORTRANNULLFUNCTION(func);
84: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.regobjgrad, (PetscVoidFn *)func, ctx);
85: if (!*ierr) *ierr = TaoADMMSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaoadmmregularizerobjgradroutine, ctx);
86: }
88: PETSC_EXTERN void taoadmmsetregularizerhessianroutine_(Tao *tao, Mat *H, Mat *Hpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
89: {
90: CHKFORTRANNULLFUNCTION(func);
91: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.reghess, (PetscVoidFn *)func, ctx);
92: if (!*ierr) *ierr = TaoADMMSetRegularizerHessianRoutine(*tao, *H, *Hpre, ourtaoadmmregularizerhessroutine, ctx);
93: }
95: PETSC_EXTERN void taoadmmsetregularizerconstraintjacobian_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
96: {
97: CHKFORTRANNULLFUNCTION(func);
98: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitjacobian, (PetscVoidFn *)func, ctx);
99: if (!*ierr) *ierr = TaoADMMSetRegularizerConstraintJacobian(*tao, *J, *Jpre, ourtaoadmmregularizerconstraintjacobian, ctx);
100: }