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

  4: #if PetscDefined(HAVE_FORTRAN_CAPS)
  5:   #define ksporthogonalizationset_                  KSPORTHOGONALIZATIONSET
  6:   #define ksporthogonalizationmodifiedgramschmidt_  KSPORTHOGONALIZATIONMODIFIEDGRAMSCHMIDT
  7:   #define ksporthogonalizationclassicalgramschmidt_ KSPORTHOGONALIZATIONCLASSICALGRAMSCHMIDT
  8: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
  9:   #define ksporthogonalizationset_                  ksporthogonalizationset
 10:   #define ksporthogonalizationmodifiedgramschmidt_  ksporthogonalizationmodifiedgramschmidt
 11:   #define ksporthogonalizationclassicalgramschmidt_ ksporthogonalizationclassicalgramschmidt
 12: #endif

 14: static struct {
 15:   PetscFortranCallbackId orthog;
 16: } _cb;

 18: PETSC_EXTERN void ksporthogonalizationmodifiedgramschmidt_(KSP *, Vec *, PetscInt *, Vec *, PetscScalar *, PetscErrorCode *);
 19: PETSC_EXTERN void ksporthogonalizationclassicalgramschmidt_(KSP *, Vec *, PetscInt *, Vec *, PetscScalar *, PetscErrorCode *);

 21: static PetscErrorCode ourorthog(KSP ksp, Vec V[], PetscInt n, Vec x, PetscScalar h[])
 22: {
 23:   PetscObjectUseFortranCallback(ksp, _cb.orthog, (KSP *, Vec *, PetscInt *, Vec *, PetscScalar *, PetscErrorCode *), (&ksp, V, &n, &x, h, &ierr));
 24: }

 26: PETSC_EXTERN void ksporthogonalizationset_(KSP *ksp, void (*orthog)(KSP *, Vec *, PetscInt *, Vec *, PetscScalar *, PetscErrorCode *), PetscErrorCode *ierr)
 27: {
 28:   if (orthog == ksporthogonalizationmodifiedgramschmidt_) {
 29:     *ierr = KSPOrthogonalizationSet(*ksp, KSPOrthogonalizationModifiedGramSchmidt);
 30:   } else if (orthog == ksporthogonalizationclassicalgramschmidt_) {
 31:     *ierr = KSPOrthogonalizationSet(*ksp, KSPOrthogonalizationClassicalGramSchmidt);
 32:   } else {
 33:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.orthog, (PetscFortranCallbackFn *)orthog, NULL);
 34:     if (*ierr) return;
 35:     *ierr = KSPOrthogonalizationSet(*ksp, ourorthog);
 36:   }
 37: }