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