Actual source code: zmgfuncf.c

  1: #include <petsc/private/fortranimpl.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 *mat, Vec *b, Vec *x, Vec *r, PetscErrorCode *ierr)
 21: {
 22:   *ierr = PCMGResidualDefault(*mat, *b, *x, *r);
 23: }

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

 34:     rr = ourresidualfunction;
 35:   }
 36:   *ierr = PCMGSetResidual(*pc, *l, rr, *mat);
 37: }