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 pcshellsetapplysymmetricleft_ PCSHELLSETAPPLYSYMMETRICLEFT 8 #define pcshellsetapplysymmetricright_ PCSHELLSETAPPLYSYMMETRICRIGHT 9 #define pcshellsetapplyba_ PCSHELLSETAPPLYBA 10 #define pcshellsetapplyrichardson_ PCSHELLSETAPPLYRICHARDSON 11 #define pcshellsetapplytranspose_ PCSHELLSETAPPLYTRANSPOSE 12 #define pcshellsetsetup_ PCSHELLSETSETUP 13 #define pcshellsetdestroy_ PCSHELLSETDESTROY 14 #define pcshellsetpresolve_ PCSHELLSETPRESOLVE 15 #define pcshellsetpostsolve_ PCSHELLSETPOSTSOLVE 16 #define pcshellsetview_ PCSHELLSETVIEW 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 pcshellsetcontext_ pcshellsetcontext 30 #define pcshellgetcontext_ pcshellgetcontext 31 #endif 32 33 /* These are not extern C because they are passed into non-extern C user level functions */ 34 static PetscErrorCode ourshellapply(PC pc, Vec x, Vec y) 35 { 36 PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, &x, &y, &ierr)); 37 return PETSC_SUCCESS; 38 } 39 40 static PetscErrorCode ourshellapplysymmetricleft(PC pc, Vec x, Vec y) 41 { 42 PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[9]))(&pc, &x, &y, &ierr)); 43 return PETSC_SUCCESS; 44 } 45 46 static PetscErrorCode ourshellapplysymmetricright(PC pc, Vec x, Vec y) 47 { 48 PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[10]))(&pc, &x, &y, &ierr)); 49 return PETSC_SUCCESS; 50 } 51 52 static PetscErrorCode ourshellapplyctx(PC pc, Vec x, Vec y) 53 { 54 void *ctx; 55 PetscCall(PCShellGetContext(pc, &ctx)); 56 PetscCallFortranVoidFunction((*(void (*)(PC *, void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, ctx, &x, &y, &ierr)); 57 return PETSC_SUCCESS; 58 } 59 60 static PetscErrorCode ourshellapplyba(PC pc, PCSide side, Vec x, Vec y, Vec work) 61 { 62 PetscCallFortranVoidFunction((*(void (*)(PC *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[1]))(&pc, &side, &x, &y, &work, &ierr)); 63 return PETSC_SUCCESS; 64 } 65 66 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) 67 { 68 PetscCallFortranVoidFunction((*(void (*)(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)); 69 return PETSC_SUCCESS; 70 } 71 72 static PetscErrorCode ourshellapplytranspose(PC pc, Vec x, Vec y) 73 { 74 PetscCallFortranVoidFunction((*(void (*)(void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc, &x, &y, &ierr)); 75 return PETSC_SUCCESS; 76 } 77 78 static PetscErrorCode ourshellsetup(PC pc) 79 { 80 PetscCallFortranVoidFunction((*(void (*)(PC *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, &ierr)); 81 return PETSC_SUCCESS; 82 } 83 84 static PetscErrorCode ourshellsetupctx(PC pc) 85 { 86 void *ctx; 87 PetscCall(PCShellGetContext(pc, &ctx)); 88 PetscCallFortranVoidFunction((*(void (*)(PC *, void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, ctx, &ierr)); 89 return PETSC_SUCCESS; 90 } 91 92 static PetscErrorCode ourshelldestroy(PC pc) 93 { 94 PetscCallFortranVoidFunction((*(void (*)(void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[5]))(&pc, &ierr)); 95 return PETSC_SUCCESS; 96 } 97 98 static PetscErrorCode ourshellpresolve(PC pc, KSP ksp, Vec x, Vec y) 99 { 100 PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[6]))(&pc, &ksp, &x, &y, &ierr)); 101 return PETSC_SUCCESS; 102 } 103 104 static PetscErrorCode ourshellpostsolve(PC pc, KSP ksp, Vec x, Vec y) 105 { 106 PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[7]))(&pc, &ksp, &x, &y, &ierr)); 107 return PETSC_SUCCESS; 108 } 109 110 static PetscErrorCode ourshellview(PC pc, PetscViewer view) 111 { 112 PetscCallFortranVoidFunction((*(void (*)(PC *, PetscViewer *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[8]))(&pc, &view, &ierr)); 113 return PETSC_SUCCESS; 114 } 115 116 PETSC_EXTERN void pcshellgetcontext_(PC *pc, void **ctx, PetscErrorCode *ierr) 117 { 118 *ierr = PCShellGetContext(*pc, ctx); 119 } 120 121 PETSC_EXTERN void pcshellsetapply_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 122 { 123 PetscObjectAllocateFortranPointers(*pc, 11); 124 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFn *)apply; 125 126 *ierr = PCShellSetApply(*pc, ourshellapply); 127 } 128 129 PETSC_EXTERN void pcshellsetapplysymmetricleft_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 130 { 131 PetscObjectAllocateFortranPointers(*pc, 11); 132 ((PetscObject)*pc)->fortran_func_pointers[9] = (PetscVoidFn *)apply; 133 134 *ierr = PCShellSetApplySymmetricLeft(*pc, ourshellapplysymmetricleft); 135 } 136 137 PETSC_EXTERN void pcshellsetapplysymmetricright_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 138 { 139 PetscObjectAllocateFortranPointers(*pc, 11); 140 ((PetscObject)*pc)->fortran_func_pointers[10] = (PetscVoidFn *)apply; 141 142 *ierr = PCShellSetApplySymmetricRight(*pc, ourshellapplysymmetricright); 143 } 144 145 PETSC_EXTERN void pcshellsetapplyctx_(PC *pc, void (*apply)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 146 { 147 PetscObjectAllocateFortranPointers(*pc, 11); 148 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFn *)apply; 149 150 *ierr = PCShellSetApply(*pc, ourshellapplyctx); 151 } 152 153 PETSC_EXTERN void pcshellsetapplyba_(PC *pc, void (*apply)(void *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 154 { 155 PetscObjectAllocateFortranPointers(*pc, 11); 156 ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscVoidFn *)apply; 157 158 *ierr = PCShellSetApplyBA(*pc, ourshellapplyba); 159 } 160 161 PETSC_EXTERN void pcshellsetapplyrichardson_(PC *pc, void (*apply)(void *, Vec *, Vec *, Vec *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *), PetscErrorCode *ierr) 162 { 163 PetscObjectAllocateFortranPointers(*pc, 11); 164 ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFn *)apply; 165 *ierr = PCShellSetApplyRichardson(*pc, ourapplyrichardson); 166 } 167 168 PETSC_EXTERN void pcshellsetapplytranspose_(PC *pc, void (*applytranspose)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 169 { 170 PetscObjectAllocateFortranPointers(*pc, 11); 171 ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFn *)applytranspose; 172 173 *ierr = PCShellSetApplyTranspose(*pc, ourshellapplytranspose); 174 } 175 176 PETSC_EXTERN void pcshellsetsetupctx_(PC *pc, void (*setup)(void *, void *, PetscErrorCode *), PetscErrorCode *ierr) 177 { 178 PetscObjectAllocateFortranPointers(*pc, 11); 179 ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFn *)setup; 180 181 *ierr = PCShellSetSetUp(*pc, ourshellsetupctx); 182 } 183 184 PETSC_EXTERN void pcshellsetsetup_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr) 185 { 186 PetscObjectAllocateFortranPointers(*pc, 11); 187 ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFn *)setup; 188 189 *ierr = PCShellSetSetUp(*pc, ourshellsetup); 190 } 191 192 PETSC_EXTERN void pcshellsetdestroy_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr) 193 { 194 PetscObjectAllocateFortranPointers(*pc, 11); 195 ((PetscObject)*pc)->fortran_func_pointers[5] = (PetscVoidFn *)setup; 196 197 *ierr = PCShellSetDestroy(*pc, ourshelldestroy); 198 } 199 200 PETSC_EXTERN void pcshellsetpresolve_(PC *pc, void (*presolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 201 { 202 PetscObjectAllocateFortranPointers(*pc, 11); 203 ((PetscObject)*pc)->fortran_func_pointers[6] = (PetscVoidFn *)presolve; 204 205 *ierr = PCShellSetPreSolve(*pc, ourshellpresolve); 206 } 207 208 PETSC_EXTERN void pcshellsetpostsolve_(PC *pc, void (*postsolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr) 209 { 210 PetscObjectAllocateFortranPointers(*pc, 11); 211 ((PetscObject)*pc)->fortran_func_pointers[7] = (PetscVoidFn *)postsolve; 212 213 *ierr = PCShellSetPostSolve(*pc, ourshellpostsolve); 214 } 215 216 PETSC_EXTERN void pcshellsetview_(PC *pc, void (*view)(void *, PetscViewer *, PetscErrorCode *), PetscErrorCode *ierr) 217 { 218 PetscObjectAllocateFortranPointers(*pc, 11); 219 ((PetscObject)*pc)->fortran_func_pointers[8] = (PetscVoidFn *)view; 220 221 *ierr = PCShellSetView(*pc, ourshellview); 222 } 223