1 #include <petsc/private/fortranimpl.h> 2 #include <petscpc.h> 3 #include <petscksp.h> 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define pcshellsetapply_ PCSHELLSETAPPLY 7 #define pcshellsetapplyba_ PCSHELLSETAPPLYBA 8 #define pcshellsetapplyrichardson_ PCSHELLSETAPPLYRICHARDSON 9 #define pcshellsetapplytranspose_ PCSHELLSETAPPLYTRANSPOSE 10 #define pcshellsetsetup_ PCSHELLSETSETUP 11 #define pcshellsetdestroy_ PCSHELLSETDESTROY 12 #define pcshellsetpresolve_ PCSHELLSETPRESOLVE 13 #define pcshellsetpostsolve_ PCSHELLSETPOSTSOLVE 14 #define pcshellsetview_ PCSHELLSETVIEW 15 #define pcshellsetname_ PCSHELLSETNAME 16 #define pcshellgetname_ PCSHELLGETNAME 17 #define pcshellsetcontext_ PCSHELLSETCONTEXT 18 #define pcshellgetcontext_ PCSHELLGETCONTEXT 19 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 20 #define pcshellsetapply_ pcshellsetapply 21 #define pcshellsetapplyba_ pcshellsetapplyba 22 #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson 23 #define pcshellsetapplytranspose_ pcshellsetapplytranspose 24 #define pcshellsetsetup_ pcshellsetsetup 25 #define pcshellsetdestroy_ pcshellsetdestroy 26 #define pcshellsetpresolve_ pcshellsetpresolve 27 #define pcshellsetpostsolve_ pcshellsetpostsolve 28 #define pcshellsetview_ pcshellsetview 29 #define pcshellsetname_ pcshellsetname 30 #define pcshellgetname_ pcshellgetname 31 #define pcshellsetcontext_ pcshellsetcontext 32 #define pcshellgetcontext_ pcshellgetcontext 33 #endif 34 35 /* These are not extern C because they are passed into non-extern C user level functions */ 36 static PetscErrorCode ourshellapply(PC pc,Vec x,Vec y) 37 { 38 PetscErrorCode ierr = 0; 39 (*(void (PETSC_STDCALL *)(PC*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc,&x,&y,&ierr);CHKERRQ(ierr); 40 return 0; 41 } 42 43 static PetscErrorCode ourshellapplyctx(PC pc,Vec x,Vec y) 44 { 45 PetscErrorCode ierr = 0; 46 void *ctx; 47 ierr = PCShellGetContext(pc,&ctx);CHKERRQ(ierr); 48 (*(void (PETSC_STDCALL *)(PC*,void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc,ctx,&x,&y,&ierr);CHKERRQ(ierr); 49 return 0; 50 } 51 52 static PetscErrorCode ourshellapplyba(PC pc,PCSide side,Vec x,Vec y,Vec work) 53 { 54 PetscErrorCode ierr = 0; 55 (*(void (PETSC_STDCALL *)(PC*,PCSide*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[1]))(&pc,&side,&x,&y,&work,&ierr);CHKERRQ(ierr); 56 return 0; 57 } 58 59 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) 60 { 61 PetscErrorCode ierr = 0; 62 (*(void (PETSC_STDCALL *)(PC*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscBool *,PetscInt*,PCRichardsonConvergedReason*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[2]))(&pc,&x,&y,&w,&rtol,&abstol,&dtol,&m,&guesszero,outits,reason,&ierr);CHKERRQ(ierr); 63 return 0; 64 } 65 66 static PetscErrorCode ourshellapplytranspose(PC pc,Vec x,Vec y) 67 { 68 PetscErrorCode ierr = 0; 69 (*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc,&x,&y,&ierr);CHKERRQ(ierr); 70 return 0; 71 } 72 73 static PetscErrorCode ourshellsetup(PC pc) 74 { 75 PetscErrorCode ierr = 0; 76 (*(void (PETSC_STDCALL *)(PC*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc,&ierr);CHKERRQ(ierr); 77 return 0; 78 } 79 80 static PetscErrorCode ourshellsetupctx(PC pc) 81 { 82 PetscErrorCode ierr = 0; 83 void *ctx; 84 ierr = PCShellGetContext(pc,&ctx);CHKERRQ(ierr); 85 (*(void (PETSC_STDCALL *)(PC*,void*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc,ctx,&ierr);CHKERRQ(ierr); 86 return 0; 87 } 88 89 static PetscErrorCode ourshelldestroy(PC pc) 90 { 91 PetscErrorCode ierr = 0; 92 (*(void (PETSC_STDCALL *)(void*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[5]))(&pc,&ierr);CHKERRQ(ierr); 93 return 0; 94 } 95 96 static PetscErrorCode ourshellpresolve(PC pc,KSP ksp,Vec x,Vec y) 97 { 98 PetscErrorCode ierr = 0; 99 (*(void (PETSC_STDCALL *)(PC*,KSP*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[6]))(&pc,&ksp,&x,&y,&ierr);CHKERRQ(ierr); 100 return 0; 101 } 102 103 static PetscErrorCode ourshellpostsolve(PC pc,KSP ksp,Vec x,Vec y) 104 { 105 PetscErrorCode ierr = 0; 106 (*(void (PETSC_STDCALL *)(PC*,KSP*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[7]))(&pc,&ksp,&x,&y,&ierr);CHKERRQ(ierr); 107 return 0; 108 } 109 110 static PetscErrorCode ourshellview(PC pc,PetscViewer view) 111 { 112 PetscErrorCode ierr = 0; 113 (*(void (PETSC_STDCALL *)(PC*,PetscViewer*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[8]))(&pc,&view,&ierr);CHKERRQ(ierr); 114 return 0; 115 } 116 117 PETSC_EXTERN void PETSC_STDCALL pcshellgetcontext_(PC *pc,void **ctx,PetscErrorCode *ierr) 118 { 119 *ierr = PCShellGetContext(*pc,ctx); 120 } 121 122 PETSC_EXTERN void PETSC_STDCALL pcshellsetapply_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 123 { 124 PetscObjectAllocateFortranPointers(*pc,9); 125 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFunction)apply; 126 127 *ierr = PCShellSetApply(*pc,ourshellapply); 128 } 129 130 PETSC_EXTERN void PETSC_STDCALL pcshellsetapplyctx_(PC *pc,void (PETSC_STDCALL *apply)(void*,void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 131 { 132 PetscObjectAllocateFortranPointers(*pc,5); 133 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFunction)apply; 134 135 *ierr = PCShellSetApply(*pc,ourshellapplyctx); 136 } 137 138 PETSC_EXTERN void PETSC_STDCALL pcshellsetapplyba_(PC *pc,void (PETSC_STDCALL *apply)(void*,PCSide*,Vec*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 139 { 140 PetscObjectAllocateFortranPointers(*pc,9); 141 ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscVoidFunction)apply; 142 143 *ierr = PCShellSetApplyBA(*pc,ourshellapplyba); 144 } 145 146 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) 147 { 148 PetscObjectAllocateFortranPointers(*pc,9); 149 ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFunction)apply; 150 *ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson); 151 } 152 153 PETSC_EXTERN void PETSC_STDCALL pcshellsetapplytranspose_(PC *pc,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), PetscErrorCode *ierr) 154 { 155 PetscObjectAllocateFortranPointers(*pc,9); 156 ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFunction)applytranspose; 157 158 *ierr = PCShellSetApplyTranspose(*pc,ourshellapplytranspose); 159 } 160 161 PETSC_EXTERN void PETSC_STDCALL pcshellsetsetupctx_(PC *pc,void (PETSC_STDCALL *setup)(void*,void*,PetscErrorCode*),PetscErrorCode *ierr) 162 { 163 PetscObjectAllocateFortranPointers(*pc,5); 164 ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFunction)setup; 165 166 *ierr = PCShellSetSetUp(*pc,ourshellsetupctx); 167 } 168 169 PETSC_EXTERN void PETSC_STDCALL pcshellsetsetup_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 170 { 171 PetscObjectAllocateFortranPointers(*pc,9); 172 ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFunction)setup; 173 174 *ierr = PCShellSetSetUp(*pc,ourshellsetup); 175 } 176 177 PETSC_EXTERN void PETSC_STDCALL pcshellsetdestroy_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 178 { 179 PetscObjectAllocateFortranPointers(*pc,9); 180 ((PetscObject)*pc)->fortran_func_pointers[5] = (PetscVoidFunction)setup; 181 182 *ierr = PCShellSetDestroy(*pc,ourshelldestroy); 183 } 184 185 PETSC_EXTERN void PETSC_STDCALL pcshellsetpresolve_(PC *pc,void (PETSC_STDCALL *presolve)(void*,void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 186 { 187 PetscObjectAllocateFortranPointers(*pc,9); 188 ((PetscObject)*pc)->fortran_func_pointers[6] = (PetscVoidFunction)presolve; 189 190 *ierr = PCShellSetPreSolve(*pc,ourshellpresolve); 191 } 192 193 PETSC_EXTERN void PETSC_STDCALL pcshellsetpostsolve_(PC *pc,void (PETSC_STDCALL *postsolve)(void*,void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 194 { 195 PetscObjectAllocateFortranPointers(*pc,9); 196 ((PetscObject)*pc)->fortran_func_pointers[7] = (PetscVoidFunction)postsolve; 197 198 *ierr = PCShellSetPostSolve(*pc,ourshellpostsolve); 199 } 200 201 PETSC_EXTERN void PETSC_STDCALL pcshellsetview_(PC *pc,void (PETSC_STDCALL *view)(void*,PetscViewer*,PetscErrorCode*),PetscErrorCode *ierr) 202 { 203 PetscObjectAllocateFortranPointers(*pc,9); 204 ((PetscObject)*pc)->fortran_func_pointers[8] = (PetscVoidFunction)view; 205 206 *ierr = PCShellSetView(*pc,ourshellview); 207 } 208 209 PETSC_EXTERN void PETSC_STDCALL pcshellsetname_(PC *pc,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 210 { 211 char *c; 212 FIXCHAR(name,len,c); 213 *ierr = PCShellSetName(*pc,c); 214 FREECHAR(name,c); 215 } 216 217 PETSC_EXTERN void PETSC_STDCALL pcshellgetname_(PC *pc,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 218 { 219 const char *c; 220 221 *ierr = PCShellGetName(*pc,&c);if (*ierr) return; 222 *ierr = PetscStrncpy(name,c,len); 223 } 224 225 /* -----------------------------------------------------------------*/ 226 227