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