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: }