Actual source code: zmgfuncf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscpc.h>
3: #include <petsc/private/pcmgimpl.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define pcmgsetresidual_ PCMGSETRESIDUAL
7: #define pcmgresidualdefault_ PCMGRESIDUALDEFAULT
8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9: #define pcmgsetresidual_ pcmgsetresidual
10: #define pcmgresidualdefault_ pcmgresidualdefault
11: #endif
13: typedef PetscErrorCode (*MVVVV)(Mat, Vec, Vec, Vec);
14: static PetscErrorCode ourresidualfunction(Mat mat, Vec b, Vec x, Vec R)
15: {
16: PetscCallFortranVoidFunction((*(void (*)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat, &b, &x, &R, &ierr));
17: return PETSC_SUCCESS;
18: }
20: PETSC_EXTERN void pcmgresidualdefault_(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *);
22: PETSC_EXTERN void pcmgsetresidual_(PC *pc, PetscInt *l, PetscErrorCode (*residual)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *), Mat *mat, PetscErrorCode *ierr)
23: {
24: MVVVV rr;
25: if ((PetscVoidFn *)residual == (PetscVoidFn *)pcmgresidualdefault_) rr = PCMGResidualDefault;
26: else {
27: PetscObjectAllocateFortranPointers(*mat, 1);
28: /* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */
29: ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFn *)residual;
31: rr = ourresidualfunction;
32: }
33: *ierr = PCMGSetResidual(*pc, *l, rr, *mat);
34: }