Actual source code: zgmres2f.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define kspgmressetorthogonalization_                  KSPGMRESSETORTHOGONALIZATION
  6:   #define kspgmresmodifiedgramschmidtorthogonalization_  KSPGMRESMODIFIEDGRAMSCHMIDTORTHOGONALIZATION
  7:   #define kspgmresclassicalgramschmidtorthogonalization_ KSPGMRESCLASSICALGRAMSCHMIDTORTHOGONALIZATION
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define kspgmressetorthogonalization_                  kspgmressetorthogonalization
 10:   #define kspgmresmodifiedgramschmidtorthogonalization_  kspgmresmodifiedgramschmidtorthogonalization
 11:   #define kspgmresclassicalgramschmidtorthogonalization_ kspgmresclassicalgramschmidtorthogonalization
 12: #endif

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

 18: PETSC_EXTERN void kspgmresmodifiedgramschmidtorthogonalization_(KSP *ksp, PetscInt *n, PetscErrorCode *ierr)
 19: {
 20:   *ierr = KSPGMRESModifiedGramSchmidtOrthogonalization(*ksp, *n);
 21: }

 23: PETSC_EXTERN void kspgmresclassicalgramschmidtorthogonalization_(KSP *ksp, PetscInt *n, PetscErrorCode *ierr)
 24: {
 25:   *ierr = KSPGMRESClassicalGramSchmidtOrthogonalization(*ksp, *n);
 26: }

 28: static PetscErrorCode ourorthog(KSP ksp, PetscInt n)
 29: {
 30:   PetscObjectUseFortranCallback(ksp, _cb.orthog, (KSP *, PetscInt *, PetscErrorCode *), (&ksp, &n, &ierr));
 31: }

 33: PETSC_EXTERN void kspgmressetorthogonalization_(KSP *ksp, void (*orthog)(KSP *, PetscInt *, PetscErrorCode *), PetscErrorCode *ierr)
 34: {
 35:   if ((PetscVoidFn *)orthog == (PetscVoidFn *)kspgmresmodifiedgramschmidtorthogonalization_) {
 36:     *ierr = KSPGMRESSetOrthogonalization(*ksp, KSPGMRESModifiedGramSchmidtOrthogonalization);
 37:   } else if ((PetscVoidFn *)orthog == (PetscVoidFn *)kspgmresclassicalgramschmidtorthogonalization_) {
 38:     *ierr = KSPGMRESSetOrthogonalization(*ksp, KSPGMRESClassicalGramSchmidtOrthogonalization);
 39:   } else {
 40:     *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.orthog, (PetscVoidFn *)orthog, NULL);
 41:     if (*ierr) return;
 42:     *ierr = KSPGMRESSetOrthogonalization(*ksp, ourorthog);
 43:   }
 44: }