1*e54e4138SSatish Balay #include "zpetsc.h" 2*e54e4138SSatish Balay #include "petscpc.h" 3*e54e4138SSatish Balay 4*e54e4138SSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 5*e54e4138SSatish Balay #define pcshellsetapply_ PCSHELLSETAPPLY 6*e54e4138SSatish Balay #define pcshellsetapplyrichardson_ PCSHELLSETAPPLYRICHARDSON 7*e54e4138SSatish Balay #define pcshellsetapplytranspose_ PCSHELLSETAPPLYTRANSPOSE 8*e54e4138SSatish Balay #define pcshellsetsetup_ PCSHELLSETSETUP 9*e54e4138SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 10*e54e4138SSatish Balay #define pcshellsetapply_ pcshellsetapply 11*e54e4138SSatish Balay #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson 12*e54e4138SSatish Balay #define pcshellsetapplytranspose_ pcshellsetapplytranspose 13*e54e4138SSatish Balay #define pcshellsetsetup_ pcshellsetsetup 14*e54e4138SSatish Balay #endif 15*e54e4138SSatish Balay 16*e54e4138SSatish Balay EXTERN_C_BEGIN 17*e54e4138SSatish Balay static void (PETSC_STDCALL *f1)(void*,Vec*,Vec*,PetscErrorCode*); 18*e54e4138SSatish Balay static void (PETSC_STDCALL *f2)(void*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*); 19*e54e4138SSatish Balay static void (PETSC_STDCALL *f3)(void*,Vec*,Vec*,PetscErrorCode*); 20*e54e4138SSatish Balay static void (PETSC_STDCALL *f9)(void*,PetscErrorCode*); 21*e54e4138SSatish Balay EXTERN_C_END 22*e54e4138SSatish Balay 23*e54e4138SSatish Balay /* These are not extern C because they are passed into non-extern C user level functions */ 24*e54e4138SSatish Balay static PetscErrorCode ourshellapply(void *ctx,Vec x,Vec y) 25*e54e4138SSatish Balay { 26*e54e4138SSatish Balay PetscErrorCode ierr = 0; 27*e54e4138SSatish Balay (*f1)(ctx,&x,&y,&ierr);CHKERRQ(ierr); 28*e54e4138SSatish Balay return 0; 29*e54e4138SSatish Balay } 30*e54e4138SSatish Balay 31*e54e4138SSatish Balay static PetscErrorCode ourapplyrichardson(void *ctx,Vec x,Vec y,Vec w,PetscReal rtol,PetscReal abstol,PetscReal dtol,PetscInt m) 32*e54e4138SSatish Balay { 33*e54e4138SSatish Balay PetscErrorCode ierr = 0; 34*e54e4138SSatish Balay 35*e54e4138SSatish Balay (*f2)(ctx,&x,&y,&w,&rtol,&abstol,&dtol,&m,&ierr);CHKERRQ(ierr); 36*e54e4138SSatish Balay return 0; 37*e54e4138SSatish Balay } 38*e54e4138SSatish Balay 39*e54e4138SSatish Balay static PetscErrorCode ourshellapplytranspose(void *ctx,Vec x,Vec y) 40*e54e4138SSatish Balay { 41*e54e4138SSatish Balay PetscErrorCode ierr = 0; 42*e54e4138SSatish Balay (*f3)(ctx,&x,&y,&ierr);CHKERRQ(ierr); 43*e54e4138SSatish Balay return 0; 44*e54e4138SSatish Balay } 45*e54e4138SSatish Balay 46*e54e4138SSatish Balay static PetscErrorCode ourshellsetup(void *ctx) 47*e54e4138SSatish Balay { 48*e54e4138SSatish Balay PetscErrorCode ierr = 0; 49*e54e4138SSatish Balay 50*e54e4138SSatish Balay (*f9)(ctx,&ierr);CHKERRQ(ierr); 51*e54e4138SSatish Balay return 0; 52*e54e4138SSatish Balay } 53*e54e4138SSatish Balay 54*e54e4138SSatish Balay EXTERN_C_BEGIN 55*e54e4138SSatish Balay 56*e54e4138SSatish Balay void PETSC_STDCALL pcshellsetapply_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*), 57*e54e4138SSatish Balay PetscErrorCode *ierr) 58*e54e4138SSatish Balay { 59*e54e4138SSatish Balay f1 = apply; 60*e54e4138SSatish Balay *ierr = PCShellSetApply(*pc,ourshellapply); 61*e54e4138SSatish Balay } 62*e54e4138SSatish Balay 63*e54e4138SSatish Balay void PETSC_STDCALL pcshellsetapplyrichardson_(PC *pc, 64*e54e4138SSatish Balay void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,Vec *,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*), 65*e54e4138SSatish Balay PetscErrorCode *ierr) 66*e54e4138SSatish Balay { 67*e54e4138SSatish Balay f2 = apply; 68*e54e4138SSatish Balay *ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson); 69*e54e4138SSatish Balay } 70*e54e4138SSatish Balay 71*e54e4138SSatish Balay void PETSC_STDCALL pcshellsetapplytranspose_(PC *pc,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), 72*e54e4138SSatish Balay PetscErrorCode *ierr) 73*e54e4138SSatish Balay { 74*e54e4138SSatish Balay f3 = applytranspose; 75*e54e4138SSatish Balay *ierr = PCShellSetApplyTranspose(*pc,ourshellapplytranspose); 76*e54e4138SSatish Balay } 77*e54e4138SSatish Balay 78*e54e4138SSatish Balay void PETSC_STDCALL pcshellsetsetup_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 79*e54e4138SSatish Balay { 80*e54e4138SSatish Balay f9 = setup; 81*e54e4138SSatish Balay *ierr = PCShellSetSetUp(*pc,ourshellsetup); 82*e54e4138SSatish Balay } 83*e54e4138SSatish Balay 84*e54e4138SSatish Balay /* -----------------------------------------------------------------*/ 85*e54e4138SSatish Balay 86*e54e4138SSatish Balay EXTERN_C_END 87