Actual source code: zdmkspf.c

  1: #include <petsc/private/fortranimpl.h>
  2: #include <petsc/private/kspimpl.h>

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define dmkspsetcomputerhs_          DMKSPSETCOMPUTERHS
  6:   #define dmkspsetcomputeinitialguess_ DMKSPSETCOMPUTEINITIALGUESS
  7:   #define dmkspsetcomputeoperators_    DMKSPSETCOMPUTEOPERATORS
  8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  9:   #define dmkspsetcomputerhs_          dmkspsetcomputerhs          /* zdmkspf.c */
 10:   #define dmkspsetcomputeinitialguess_ dmkspsetcomputeinitialguess /* zdmkspf.c */
 11:   #define dmkspsetcomputeoperators_    dmkspsetcomputeoperators    /* zdmkspf */
 12: #endif

 14: static PetscErrorCode ourkspcomputerhs(KSP ksp, Vec b, void *ctx)
 15: {
 16:   DM    dm;
 17:   DMKSP kdm;
 18:   PetscCall(KSPGetDM(ksp, &dm));
 19:   PetscCall(DMGetDMKSP(dm, &kdm));
 20:   PetscCallFortranVoidFunction((*(void (*)(KSP *, Vec *, void *, PetscErrorCode *))kdm->fortran_func_pointers[0])(&ksp, &b, ctx, &ierr));
 21:   return PETSC_SUCCESS;
 22: }

 24: static PetscErrorCode ourkspcomputeinitialguess(KSP ksp, Vec b, void *ctx)
 25: {
 26:   DM    dm;
 27:   DMKSP kdm;
 28:   PetscCall(KSPGetDM(ksp, &dm));
 29:   PetscCall(DMGetDMKSP(dm, &kdm));
 30:   PetscCallFortranVoidFunction((*(void (*)(KSP *, Vec *, void *, PetscErrorCode *))kdm->fortran_func_pointers[2])(&ksp, &b, ctx, &ierr));
 31:   return PETSC_SUCCESS;
 32: }

 34: static PetscErrorCode ourkspcomputeoperators(KSP ksp, Mat A, Mat B, void *ctx)
 35: {
 36:   DM    dm;
 37:   DMKSP kdm;
 38:   PetscCall(KSPGetDM(ksp, &dm));
 39:   PetscCall(DMGetDMKSP(dm, &kdm));
 40:   PetscCallFortranVoidFunction((*(void (*)(KSP *, Mat *, Mat *, void *, PetscErrorCode *))kdm->fortran_func_pointers[1])(&ksp, &A, &B, ctx, &ierr));
 41:   return PETSC_SUCCESS;
 42: }

 44: /* The counting for fortran_func_pointers is insanely brittle. We're putting these inside the base DM, but we have no
 45:  * way to be sure there is room other than to grep the sources from src/dm (and any other possible client). Fortran
 46:  * function pointers need an overhaul.
 47:  */

 49: PETSC_EXTERN void dmkspsetcomputerhs_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 50: {
 51:   DMKSP kdm;
 52:   *ierr = DMGetDMKSP(*dm, &kdm);
 53:   if (!*ierr) {
 54:     kdm->fortran_func_pointers[0] = (PetscVoidFn *)func;
 55:     *ierr                         = DMKSPSetComputeRHS(*dm, ourkspcomputerhs, ctx);
 56:   }
 57: }

 59: PETSC_EXTERN void dmkspsetcomputeinitialguess_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 60: {
 61:   DMKSP kdm;
 62:   *ierr = DMGetDMKSP(*dm, &kdm);
 63:   if (!*ierr) {
 64:     kdm->fortran_func_pointers[2] = (PetscVoidFn *)func;

 66:     *ierr = DMKSPSetComputeInitialGuess(*dm, ourkspcomputeinitialguess, ctx);
 67:   }
 68: }

 70: PETSC_EXTERN void dmkspsetcomputeoperators_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
 71: {
 72:   DMKSP kdm;
 73:   *ierr = DMGetDMKSP(*dm, &kdm);
 74:   if (!*ierr) {
 75:     kdm->fortran_func_pointers[1] = (PetscVoidFn *)func;
 76:     *ierr                         = DMKSPSetComputeOperators(*dm, ourkspcomputeoperators, ctx);
 77:   }
 78: }