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 #define pcshellsetcontext_ PCSHELLSETCONTEXT 11 #define pcshellgetcontext_ PCSHELLGETCONTEXT 12 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 13 #define pcshellsetapply_ pcshellsetapply 14 #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson 15 #define pcshellsetapplytranspose_ pcshellsetapplytranspose 16 #define pcshellsetsetup_ pcshellsetsetup 17 #define pcshellsetname_ pcshellsetname 18 #define pcshellsetcontext_ pcshellsetcontext 19 #define pcshellgetcontext_ pcshellgetcontext 20 #endif 21 22 /* These are not extern C because they are passed into non-extern C user level functions */ 23 static PetscErrorCode ourshellapply(void *ctx,Vec x,Vec y) 24 { 25 PetscErrorCode ierr = 0; 26 PC pc = (PC)ctx; 27 void *mctx = (void*) ((PetscObject)pc)->fortran_func_pointers[0]; 28 (*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[1]))(mctx,&x,&y,&ierr);CHKERRQ(ierr); 29 return 0; 30 } 31 32 static PetscErrorCode ourapplyrichardson(void *ctx,Vec x,Vec y,Vec w,PetscReal rtol,PetscReal abstol,PetscReal dtol,PetscInt m) 33 { 34 PetscErrorCode ierr = 0; 35 36 PC pc = (PC)ctx; 37 void *mctx = (void*) ((PetscObject)pc)->fortran_func_pointers[0]; 38 (*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[2]))(mctx,&x,&y,&w,&rtol,&abstol,&dtol,&m,&ierr);CHKERRQ(ierr); 39 return 0; 40 } 41 42 static PetscErrorCode ourshellapplytranspose(void *ctx,Vec x,Vec y) 43 { 44 PetscErrorCode ierr = 0; 45 PC pc = (PC)ctx; 46 void *mctx = (void*) ((PetscObject)pc)->fortran_func_pointers[0]; 47 (*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[3]))(mctx,&x,&y,&ierr);CHKERRQ(ierr); 48 return 0; 49 } 50 51 static PetscErrorCode ourshellsetup(void *ctx) 52 { 53 PetscErrorCode ierr = 0; 54 55 PC pc = (PC)ctx; 56 void *mctx = (void*) ((PetscObject)pc)->fortran_func_pointers[0]; 57 (*(void (PETSC_STDCALL *)(void*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[4]))(mctx,&ierr);CHKERRQ(ierr); 58 return 0; 59 } 60 61 EXTERN_C_BEGIN 62 63 void PETSC_STDCALL pcshellsetcontext_(PC *pc,void*ctx, int *__ierr ) 64 { 65 /* the Fortran context is stored in the func_pointer container, while pc is used as the context */ 66 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFunction)ctx; 67 *__ierr = PCShellSetContext(*pc,*pc); 68 } 69 70 void PETSC_STDCALL pcshellgetcontext_(PC *pc,void**ctx, int *__ierr ) 71 { 72 /* the Fortran context is stored in the func_pointer container, while pc is used as the context */ 73 *ctx = (void*) ((PetscObject)*pc)->fortran_func_pointers[0]; 74 } 75 76 void PETSC_STDCALL pcshellsetapply_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*),PetscErrorCode *ierr) 77 { 78 PetscObjectAllocateFortranPointers(*pc,5); 79 ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscVoidFunction)apply; 80 *ierr = PCShellSetApply(*pc,ourshellapply);if (*ierr) return; 81 *ierr = PCShellSetContext(*pc,*pc); 82 } 83 84 void PETSC_STDCALL pcshellsetapplyrichardson_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,Vec *,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr) 85 { 86 PetscObjectAllocateFortranPointers(*pc,5); 87 ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFunction)apply; 88 *ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson);if (*ierr) return; 89 *ierr = PCShellSetContext(*pc,*pc); 90 } 91 92 void PETSC_STDCALL pcshellsetapplytranspose_(PC *pc,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), PetscErrorCode *ierr) 93 { 94 PetscObjectAllocateFortranPointers(*pc,5); 95 ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFunction)applytranspose; 96 *ierr = PCShellSetApplyTranspose(*pc,ourshellapplytranspose);if (*ierr) return; 97 *ierr = PCShellSetContext(*pc,*pc); 98 } 99 100 void PETSC_STDCALL pcshellsetsetup_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 101 { 102 PetscObjectAllocateFortranPointers(*pc,5); 103 ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFunction)setup; 104 *ierr = PCShellSetSetUp(*pc,ourshellsetup);if (*ierr) return; 105 *ierr = PCShellSetContext(*pc,*pc); 106 } 107 108 void PETSC_STDCALL pcshellsetname_(PC *pc,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 109 { 110 char *c; 111 FIXCHAR(name,len,c); 112 *ierr = PCShellSetName(*pc,c); 113 FREECHAR(name,c); 114 } 115 116 /* -----------------------------------------------------------------*/ 117 118 EXTERN_C_END 119