Actual source code: zdmkspf.c

      1: #include <petsc/private/ftnimpl.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
     10:   #define dmkspsetcomputeinitialguess_ dmkspsetcomputeinitialguess
     11:   #define dmkspsetcomputeoperators_    dmkspsetcomputeoperators
     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] = (PetscFortranCallbackFn *)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] = (PetscFortranCallbackFn *)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] = (PetscFortranCallbackFn *)func;
     76:     *ierr                         = DMKSPSetComputeOperators(*dm, ourkspcomputeoperators, ctx);
     77:   }
     78: }