1af0996ceSBarry Smith #include <petsc/private/fortranimpl.h> 2c6db04a5SJed Brown #include <petscpc.h> 3af0996ceSBarry Smith #include <petsc/private/pcmgimpl.h> 4e54e4138SSatish Balay 5e54e4138SSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 6e54e4138SSatish Balay #define pcmgsetresidual_ PCMGSETRESIDUAL 754b2cd4bSJed Brown #define pcmgresidualdefault_ PCMGRESIDUALDEFAULT 8e54e4138SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9e54e4138SSatish Balay #define pcmgsetresidual_ pcmgsetresidual 1054b2cd4bSJed Brown #define pcmgresidualdefault_ pcmgresidualdefault 1136f61ee5SJed Brown #endif 1236f61ee5SJed Brown 13e54e4138SSatish Balay typedef PetscErrorCode (*MVVVV)(Mat,Vec,Vec,Vec); 14e54e4138SSatish Balay static PetscErrorCode ourresidualfunction(Mat mat,Vec b,Vec x,Vec R) 15e54e4138SSatish Balay { 16e54e4138SSatish Balay PetscErrorCode ierr = 0; 17*19caf8f3SSatish Balay (*(void (*)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&b,&x,&R,&ierr); 18e54e4138SSatish Balay return 0; 19e54e4138SSatish Balay } 20e54e4138SSatish Balay 2154b2cd4bSJed Brown PETSC_EXTERN void pcmgresidualdefault_(Mat *mat,Vec *b,Vec *x,Vec *r, PetscErrorCode *ierr) 221f6cc5b2SSatish Balay { 2354b2cd4bSJed Brown *ierr = PCMGResidualDefault(*mat,*b,*x,*r); 241f6cc5b2SSatish Balay } 25e54e4138SSatish Balay 26*19caf8f3SSatish Balay PETSC_EXTERN void pcmgsetresidual_(PC *pc,PetscInt *l,PetscErrorCode (*residual)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*),Mat *mat, PetscErrorCode *ierr) 27e54e4138SSatish Balay { 28e54e4138SSatish Balay MVVVV rr; 2954b2cd4bSJed Brown if ((PetscVoidFunction)residual == (PetscVoidFunction)pcmgresidualdefault_) rr = PCMGResidualDefault; 30e54e4138SSatish Balay else { 317850c7c0SBarry Smith PetscObjectAllocateFortranPointers(*mat,1); 327850c7c0SBarry Smith /* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */ 33f68b968cSBarry Smith ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)residual; 342fa5cd67SKarl Rupp 35e54e4138SSatish Balay rr = ourresidualfunction; 36e54e4138SSatish Balay } 37e54e4138SSatish Balay *ierr = PCMGSetResidual(*pc,*l,rr,*mat); 38e54e4138SSatish Balay } 39e54e4138SSatish Balay 40