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