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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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] = (PetscVoidFunction)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);if (*ierr) return; 233 FREECHAR(name,c); 234 } 235 236 PETSC_EXTERN void pcshellgetname_(PC *pc,char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 237 { 238 const char *c; 239 240 *ierr = PCShellGetName(*pc,&c);if (*ierr) return; 241 *ierr = PetscStrncpy(name,c,len);if (*ierr) return; 242 FIXRETURNCHAR(PETSC_TRUE,name,len); 243 } 244