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