Actual source code: zadmmf.c

  1: #include <petsc/private/ftnimpl.h>
  2: #include <petsc/private/taoimpl.h>

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define taoadmmsetmisfitobjectiveandgradientroutine_      TAOADMMSETMISFITOBJECTIVEANDGRADIENTROUTINE
  6:   #define taoadmmsetmisfithessianroutine_                   TAOADMMSETMISFITHESSIANROUTINE
  7:   #define taoadmmsetmisfitconstraintjacobian_               TAOADMMSETMISFITCONSTRAINTJACOBIAN
  8:   #define taoadmmsetregularizerobjectiveandgradientroutine_ TAOADMMSETREGULARIZEROBJECTIVEANDGRADIENTROUTINE
  9:   #define taoadmmsetregularizerhessianroutine_              TAOADMMSETREGULARIZERHESSIANROUTINE
 10:   #define taoadmmsetregularizerconstraintjacobian_          TAOADMMSETREGULARIZERCONSTRAINTJACOBIAN
 11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 12:   #define taoadmmsetmisfitobjectiveandgradientroutine_      taoadmmsetmisfitobjectiveandgradientroutine
 13:   #define taoadmmsetmisfithessianroutine_                   taoadmmsetmisfithessianroutine
 14:   #define taoadmmsetmisfitconstraintjacobian_               taoadmmsetmisfitconstraintjacobian
 15:   #define taoadmmsetregularizerobjectiveandgradientroutine_ taoadmmsetregularizerobjectiveandgradientroutine
 16:   #define taoadmmsetregularizerhessianroutine_              taoadmmsetregularizerhessianroutine
 17:   #define taoadmmsetregularizerconstraintjacobian_          taoadmmsetregularizerconstraintjacobian
 18: #endif

 20: static struct {
 21:   PetscFortranCallbackId misfitobjgrad;
 22:   PetscFortranCallbackId misfithess;
 23:   PetscFortranCallbackId misfitjacobian;
 24:   PetscFortranCallbackId regobjgrad;
 25:   PetscFortranCallbackId reghess;
 26:   PetscFortranCallbackId regjacobian;
 27: } _cb;

 29: static PetscErrorCode ourtaoadmmmisfitobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
 30: {
 31:   PetscObjectUseFortranCallback(tao, _cb.misfitobjgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
 32: }

 34: static PetscErrorCode ourtaoadmmmisfithessroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
 35: {
 36:   PetscObjectUseFortranCallback(tao, _cb.misfithess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
 37: }

 39: static PetscErrorCode ourtaoadmmmisfitconstraintjacobian(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
 40: {
 41:   PetscObjectUseFortranCallback(tao, _cb.misfitjacobian, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
 42: }

 44: static PetscErrorCode ourtaoadmmregularizerobjgradroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
 45: {
 46:   PetscObjectUseFortranCallback(tao, _cb.regobjgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
 47: }

 49: static PetscErrorCode ourtaoadmmregularizerhessroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
 50: {
 51:   PetscObjectUseFortranCallback(tao, _cb.reghess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
 52: }

 54: static PetscErrorCode ourtaoadmmregularizerconstraintjacobian(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
 55: {
 56:   PetscObjectUseFortranCallback(tao, _cb.regjacobian, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
 57: }

 59: PETSC_EXTERN void taoadmmsetmisfitobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 60: {
 61:   CHKFORTRANNULLFUNCTION(func);
 62:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitobjgrad, (PetscVoidFn *)func, ctx);
 63:   if (!*ierr) *ierr = TaoADMMSetMisfitObjectiveAndGradientRoutine(*tao, ourtaoadmmmisfitobjgradroutine, ctx);
 64: }

 66: PETSC_EXTERN void taoadmmsetmisfithessianroutine_(Tao *tao, Mat *H, Mat *Hpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 67: {
 68:   CHKFORTRANNULLFUNCTION(func);
 69:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfithess, (PetscVoidFn *)func, ctx);
 70:   if (!*ierr) *ierr = TaoADMMSetMisfitHessianRoutine(*tao, *H, *Hpre, ourtaoadmmmisfithessroutine, ctx);
 71: }

 73: PETSC_EXTERN void taoadmmsetmisfitconstraintjacobian_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 74: {
 75:   CHKFORTRANNULLFUNCTION(func);
 76:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitjacobian, (PetscVoidFn *)func, ctx);
 77:   if (!*ierr) *ierr = TaoADMMSetMisfitConstraintJacobian(*tao, *J, *Jpre, ourtaoadmmmisfitconstraintjacobian, ctx);
 78: }

 80: PETSC_EXTERN void taoadmmsetregularizerobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 81: {
 82:   CHKFORTRANNULLFUNCTION(func);
 83:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.regobjgrad, (PetscVoidFn *)func, ctx);
 84:   if (!*ierr) *ierr = TaoADMMSetRegularizerObjectiveAndGradientRoutine(*tao, ourtaoadmmregularizerobjgradroutine, ctx);
 85: }

 87: PETSC_EXTERN void taoadmmsetregularizerhessianroutine_(Tao *tao, Mat *H, Mat *Hpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 88: {
 89:   CHKFORTRANNULLFUNCTION(func);
 90:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.reghess, (PetscVoidFn *)func, ctx);
 91:   if (!*ierr) *ierr = TaoADMMSetRegularizerHessianRoutine(*tao, *H, *Hpre, ourtaoadmmregularizerhessroutine, ctx);
 92: }

 94: PETSC_EXTERN void taoadmmsetregularizerconstraintjacobian_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 95: {
 96:   CHKFORTRANNULLFUNCTION(func);
 97:   *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.misfitjacobian, (PetscVoidFn *)func, ctx);
 98:   if (!*ierr) *ierr = TaoADMMSetRegularizerConstraintJacobian(*tao, *J, *Jpre, ourtaoadmmregularizerconstraintjacobian, ctx);
 99: }