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 { 163ba16761SJacob Faibussowitsch PetscCallFortranVoidFunction((*(void (*)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat, &b, &x, &R, &ierr)); 173ba16761SJacob Faibussowitsch return PETSC_SUCCESS; 18e54e4138SSatish Balay } 19e54e4138SSatish Balay 2054b2cd4bSJed Brown PETSC_EXTERN void pcmgresidualdefault_(Mat *mat, Vec *b, Vec *x, Vec *r, PetscErrorCode *ierr) 211f6cc5b2SSatish Balay { 2254b2cd4bSJed Brown *ierr = PCMGResidualDefault(*mat, *b, *x, *r); 231f6cc5b2SSatish Balay } 24e54e4138SSatish Balay 2519caf8f3SSatish Balay PETSC_EXTERN void pcmgsetresidual_(PC *pc, PetscInt *l, PetscErrorCode (*residual)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *), Mat *mat, PetscErrorCode *ierr) 26e54e4138SSatish Balay { 27e54e4138SSatish Balay MVVVV rr; 28*8434afd1SBarry Smith if ((PetscVoidFn *)residual == (PetscVoidFn *)pcmgresidualdefault_) rr = PCMGResidualDefault; 29e54e4138SSatish Balay else { 307850c7c0SBarry Smith PetscObjectAllocateFortranPointers(*mat, 1); 317850c7c0SBarry Smith /* Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */ 32*8434afd1SBarry Smith ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFn *)residual; 332fa5cd67SKarl Rupp 34e54e4138SSatish Balay rr = ourresidualfunction; 35e54e4138SSatish Balay } 36e54e4138SSatish Balay *ierr = PCMGSetResidual(*pc, *l, rr, *mat); 37e54e4138SSatish Balay } 38