1 #include <petsc-private/fortranimpl.h> 2 #include <petscpc.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define pcmgsetresidual_ PCMGSETRESIDUAL 6 #define pcmgdefaultresidual_ PCMGDEFAULTRESIDUAL 7 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8 #define pcmgsetresidual_ pcmgsetresidual 9 #define pcmgdefaultresidual_ pcmgdefaultresidual 10 #endif 11 12 typedef PetscErrorCode (*MVVVV)(Mat,Vec,Vec,Vec); 13 static PetscErrorCode ourresidualfunction(Mat mat,Vec b,Vec x,Vec R) 14 { 15 PetscErrorCode ierr = 0; 16 (*(void (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&b,&x,&R,&ierr); 17 return 0; 18 } 19 20 PETSC_EXTERN void pcmgdefaultresidual_(Mat *mat,Vec *b,Vec *x,Vec *r, PetscErrorCode *ierr) 21 { 22 *ierr = PCMGDefaultResidual(*mat,*b,*x,*r); 23 } 24 25 PETSC_EXTERN void PETSC_STDCALL pcmgsetresidual_(PC *pc,PetscInt *l,PetscErrorCode (*residual)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*),Mat *mat, PetscErrorCode *ierr) 26 { 27 MVVVV rr; 28 if ((PetscVoidFunction)residual == (PetscVoidFunction)pcmgdefaultresidual_) rr = PCMGDefaultResidual; 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] = (PetscVoidFunction)residual; 33 34 rr = ourresidualfunction; 35 } 36 *ierr = PCMGSetResidual(*pc,*l,rr,*mat); 37 } 38 39