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 *mat, Vec *b, Vec *x, Vec *r, PetscErrorCode *ierr)
21: {
22: *ierr = PCMGResidualDefault(*mat, *b, *x, *r);
23: }
25: PETSC_EXTERN void pcmgsetresidual_(PC *pc, PetscInt *l, PetscErrorCode (*residual)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *), Mat *mat, PetscErrorCode *ierr)
26: {
27: MVVVV rr;
28: if ((PetscVoidFn *)residual == (PetscVoidFn *)pcmgresidualdefault_) rr = PCMGResidualDefault;
29: else {
30: PetscObjectAllocateFortranPointers(*mat, 1);
31: /* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */
32: ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFn *)residual;
34: rr = ourresidualfunction;
35: }
36: *ierr = PCMGSetResidual(*pc, *l, rr, *mat);
37: }