1 #include "private/fortranimpl.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 #define pcshellsetname_ PCSHELLSETNAME 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define pcshellsetapply_ pcshellsetapply 12 #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson 13 #define pcshellsetapplytranspose_ pcshellsetapplytranspose 14 #define pcshellsetsetup_ pcshellsetsetup 15 #define pcshellsetname_ pcshellsetname 16 #endif 17 18 EXTERN_C_BEGIN 19 static void (PETSC_STDCALL *f1)(void*,Vec*,Vec*,PetscErrorCode*); 20 static void (PETSC_STDCALL *f2)(void*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*); 21 static void (PETSC_STDCALL *f3)(void*,Vec*,Vec*,PetscErrorCode*); 22 static void (PETSC_STDCALL *f9)(void*,PetscErrorCode*); 23 EXTERN_C_END 24 25 /* These are not extern C because they are passed into non-extern C user level functions */ 26 static PetscErrorCode ourshellapply(void *ctx,Vec x,Vec y) 27 { 28 PetscErrorCode ierr = 0; 29 (*f1)(ctx,&x,&y,&ierr);CHKERRQ(ierr); 30 return 0; 31 } 32 33 static PetscErrorCode ourapplyrichardson(void *ctx,Vec x,Vec y,Vec w,PetscReal rtol,PetscReal abstol,PetscReal dtol,PetscInt m) 34 { 35 PetscErrorCode ierr = 0; 36 37 (*f2)(ctx,&x,&y,&w,&rtol,&abstol,&dtol,&m,&ierr);CHKERRQ(ierr); 38 return 0; 39 } 40 41 static PetscErrorCode ourshellapplytranspose(void *ctx,Vec x,Vec y) 42 { 43 PetscErrorCode ierr = 0; 44 (*f3)(ctx,&x,&y,&ierr);CHKERRQ(ierr); 45 return 0; 46 } 47 48 static PetscErrorCode ourshellsetup(void *ctx) 49 { 50 PetscErrorCode ierr = 0; 51 52 (*f9)(ctx,&ierr);CHKERRQ(ierr); 53 return 0; 54 } 55 56 EXTERN_C_BEGIN 57 58 void PETSC_STDCALL pcshellsetapply_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*), 59 PetscErrorCode *ierr) 60 { 61 f1 = apply; 62 *ierr = PCShellSetApply(*pc,ourshellapply); 63 } 64 65 void PETSC_STDCALL pcshellsetapplyrichardson_(PC *pc, 66 void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,Vec *,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*), 67 PetscErrorCode *ierr) 68 { 69 f2 = apply; 70 *ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson); 71 } 72 73 void PETSC_STDCALL pcshellsetapplytranspose_(PC *pc,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), 74 PetscErrorCode *ierr) 75 { 76 f3 = applytranspose; 77 *ierr = PCShellSetApplyTranspose(*pc,ourshellapplytranspose); 78 } 79 80 void PETSC_STDCALL pcshellsetsetup_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 81 { 82 f9 = setup; 83 *ierr = PCShellSetSetUp(*pc,ourshellsetup); 84 } 85 86 void PETSC_STDCALL pcshellsetname_(PC *pc,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 87 { 88 char *c; 89 FIXCHAR(name,len,c); 90 *ierr = PCShellSetName(*pc,c); 91 FREECHAR(name,c); 92 } 93 94 /* -----------------------------------------------------------------*/ 95 96 EXTERN_C_END 97