Actual source code: zmgfuncf.c

      1: #include <petsc/private/ftnimpl.h>
      2: #include <petscpc.h>
      3: #include <petsc/private/pcmgimpl.h>

      5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      6:   #define pcmgsetresidual_     PCMGSETRESIDUAL
      7:   #define pcmgresidualdefault_ PCMGRESIDUALDEFAULT
      8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
      9:   #define pcmgsetresidual_     pcmgsetresidual
     10:   #define pcmgresidualdefault_ pcmgresidualdefault
     11: #endif

     13: typedef PetscErrorCode (*MVVVV)(Mat, Vec, Vec, Vec);
     14: static PetscErrorCode ourresidualfunction(Mat mat, Vec b, Vec x, Vec R)
     15: {
     16:   PetscCallFortranVoidFunction((*(void (*)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat, &b, &x, &R, &ierr));
     17:   return PETSC_SUCCESS;
     18: }

     20: PETSC_EXTERN void pcmgresidualdefault_(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *);

     22: PETSC_EXTERN void pcmgsetresidual_(PC *pc, PetscInt *l, void (*residual)(Mat *, Vec *, Vec *, Vec *, PetscErrorCode *), Mat *mat, PetscErrorCode *ierr)
     23: {
     24:   MVVVV rr;
     25:   if (residual == pcmgresidualdefault_) rr = PCMGResidualDefault;
     26:   else {
     27:     PetscObjectAllocateFortranPointers(*mat, 1);
     28:     /*  Attach the residual computer to the Mat, this is not ideal but the only object/context passed in the residual computer */
     29:     ((PetscObject)*mat)->fortran_func_pointers[0] = (PetscFortranCallbackFn *)residual;

     31:     rr = ourresidualfunction;
     32:   }
     33:   *ierr = PCMGSetResidual(*pc, *l, rr, *mat);
     34: }