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