1 #include <petsc/private/ftnimpl.h>
2 #include <petscpc.h>
3 #include <petsc/private/pcmgimpl.h>
4
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
12
13 typedef PetscErrorCode (*MVVVV)(Mat, Vec, Vec, Vec);
ourresidualfunction(Mat mat,Vec b,Vec x,Vec R)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 }
19
20 PETSC_EXTERN void pcmgresidualdefault_(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *);
21
pcmgsetresidual_(PC * pc,PetscInt * l,void (* residual)(Mat *,Vec *,Vec *,Vec *,PetscErrorCode *),Mat * mat,PetscErrorCode * ierr)22 PETSC_EXTERN void pcmgsetresidual_(PC *pc, PetscInt *l, void (*residual)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *), Mat *mat, PetscErrorCode *ierr)
23 {
24 MVVVV rr;
25 if (residual == 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] = (PetscFortranCallbackFn *)residual;
30
31 rr = ourresidualfunction;
32 }
33 *ierr = PCMGSetResidual(*pc, *l, rr, *mat);
34 }
35