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