1 #include "zpetsc.h" 2 #include "petscpc.h" 3 #include "petscmg.h" 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define pcmgsetresidual_ PCMGSETRESIDUAL 7 #define pcmgdefaultresidual_ PCMGDEFAULTRESIDUAL 8 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define pcmgsetresidual_ pcmgsetresidual 10 #define pcmgdefaultresidual_ pcmgdefaultresidual 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 PetscErrorCode ierr = 0; 17 (*(void (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&b,&x,&R,&ierr); 18 return 0; 19 } 20 21 EXTERN_C_BEGIN 22 extern void PETSC_STDCALL pcmgdefaultresidual_(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*); 23 24 void PETSC_STDCALL pcmgsetresidual_(PC *pc,PetscInt *l,PetscErrorCode (*residual)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*),Mat *mat, PetscErrorCode *ierr) 25 { 26 MVVVV rr; 27 if ((FCNVOID)residual == (FCNVOID)pcmgdefaultresidual_) rr = PCMGDefaultResidual; 28 else { 29 if (!((PetscObject)*mat)->fortran_func_pointers) { 30 *ierr = PetscMalloc(1*sizeof(void*),&((PetscObject)*mat)->fortran_func_pointers); 31 } 32 ((PetscObject)*mat)->fortran_func_pointers[0] = (FCNVOID)residual; 33 rr = ourresidualfunction; 34 } 35 *ierr = PCMGSetResidual(*pc,*l,rr,*mat); 36 } 37 38 EXTERN_C_END 39