1 #include <petsc/private/fortranimpl.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); 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 *mat, Vec *b, Vec *x, Vec *r, PetscErrorCode *ierr) 21 { 22 *ierr = PCMGResidualDefault(*mat, *b, *x, *r); 23 } 24 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; 33 34 rr = ourresidualfunction; 35 } 36 *ierr = PCMGSetResidual(*pc, *l, rr, *mat); 37 } 38