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