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