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