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