1 #include <petsc/private/fortranimpl.h> 2 #include <petsc/private/f90impl.h> 3 #include <petsc/private/taoimpl.h> 4 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 20 21 static struct { 22 PetscFortranCallbackId misfitobjgrad; 23 PetscFortranCallbackId misfithess; 24 PetscFortranCallbackId misfitjacobian; 25 PetscFortranCallbackId regobjgrad; 26 PetscFortranCallbackId reghess; 27 PetscFortranCallbackId regjacobian; 28 } _cb; 29 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 } 34 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 } 39 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 } 44 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 } 49 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 } 54 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 } 59 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 } 66 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 } 73 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 } 80 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 } 87 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 } 94 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 } 101