1 #include <petsc-private/fortranimpl.h> 2 #include <petscpc.h> 3 #include <../src/ksp/pc/impls/mg/mgimpl.h> 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define pcmgsetresidual_ PCMGSETRESIDUAL 7 #define pcmgresidual_default_ PCMGRESIDUAL_DEFAULT 8 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define pcmgsetresidual_ pcmgsetresidual 10 #define pcmgresidual_default_ pcmgresidual_default 11 #endif 12 13 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 14 # define pcmgresidual_default_ pcmgresidual_default__ 15 #endif 16 17 typedef PetscErrorCode (*MVVVV)(Mat,Vec,Vec,Vec); 18 static PetscErrorCode ourresidualfunction(Mat mat,Vec b,Vec x,Vec R) 19 { 20 PetscErrorCode ierr = 0; 21 (*(void (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&b,&x,&R,&ierr); 22 return 0; 23 } 24 25 PETSC_EXTERN void pcmgresidual_default_(Mat *mat,Vec *b,Vec *x,Vec *r, PetscErrorCode *ierr) 26 { 27 *ierr = PCMGResidual_Default(*mat,*b,*x,*r); 28 } 29 30 PETSC_EXTERN void PETSC_STDCALL pcmgsetresidual_(PC *pc,PetscInt *l,PetscErrorCode (*residual)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*),Mat *mat, PetscErrorCode *ierr) 31 { 32 MVVVV rr; 33 if ((PetscVoidFunction)residual == (PetscVoidFunction)pcmgresidual_default_) rr = PCMGResidual_Default; 34 else { 35 PetscObjectAllocateFortranPointers(*mat,1); 36 /* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */ 37 ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)residual; 38 39 rr = ourresidualfunction; 40 } 41 *ierr = PCMGSetResidual(*pc,*l,rr,*mat); 42 } 43 44