1 #include "private/fortranimpl.h" 2 #include "petscpc.h" 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define pcshellsetapply_ PCSHELLSETAPPLY 6 #define pcshellsetapplyrichardson_ PCSHELLSETAPPLYRICHARDSON 7 #define pcshellsetapplytranspose_ PCSHELLSETAPPLYTRANSPOSE 8 #define pcshellsetsetup_ PCSHELLSETSETUP 9 #define pcshellsetdestroy_ PCSHELLSETDESTROY 10 #define pcshellsetname_ PCSHELLSETNAME 11 #define pcshellsetcontext_ PCSHELLSETCONTEXT 12 #define pcshellgetcontext_ PCSHELLGETCONTEXT 13 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 14 #define pcshellsetapply_ pcshellsetapply 15 #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson 16 #define pcshellsetapplytranspose_ pcshellsetapplytranspose 17 #define pcshellsetsetup_ pcshellsetsetup 18 #define pcshellsetdestroy_ pcshellsetdestroy 19 #define pcshellsetname_ pcshellsetname 20 #define pcshellsetcontext_ pcshellsetcontext 21 #define pcshellgetcontext_ pcshellgetcontext 22 #endif 23 24 /* These are not extern C because they are passed into non-extern C user level functions */ 25 static PetscErrorCode ourshellapply(PC pc,Vec x,Vec y) 26 { 27 PetscErrorCode ierr = 0; 28 (*(void (PETSC_STDCALL *)(PC*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc,&x,&y,&ierr);CHKERRQ(ierr); 29 return 0; 30 } 31 32 static PetscErrorCode ourapplyrichardson(PC pc,Vec x,Vec y,Vec w,PetscReal rtol,PetscReal abstol,PetscReal dtol,PetscInt m,PetscInt *outits,PCRichardsonConvergedReason *reason) 33 { 34 PetscErrorCode ierr = 0; 35 (*(void (PETSC_STDCALL *)(PC*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscInt*,PCRichardsonConvergedReason*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[1]))(&pc,&x,&y,&w,&rtol,&abstol,&dtol,&m,outits,reason,&ierr);CHKERRQ(ierr); 36 return 0; 37 } 38 39 static PetscErrorCode ourshellapplytranspose(PC pc,Vec x,Vec y) 40 { 41 PetscErrorCode ierr = 0; 42 (*(void (PETSC_STDCALL *)(void*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[2]))(&pc,&x,&y,&ierr);CHKERRQ(ierr); 43 return 0; 44 } 45 46 static PetscErrorCode ourshellsetup(PC pc) 47 { 48 PetscErrorCode ierr = 0; 49 (*(void (PETSC_STDCALL *)(PC*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc,&ierr);CHKERRQ(ierr); 50 return 0; 51 } 52 53 static PetscErrorCode ourshelldestroy(PC pc) 54 { 55 PetscErrorCode ierr = 0; 56 (*(void (PETSC_STDCALL *)(void*,PetscErrorCode*))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc,&ierr);CHKERRQ(ierr); 57 return 0; 58 } 59 60 EXTERN_C_BEGIN 61 62 void PETSC_STDCALL pcshellsetcontext_(PC *pc,void *ctx,PetscErrorCode *ierr){ 63 *ierr = PCShellSetContext(*pc,ctx); 64 } 65 66 void PETSC_STDCALL pcshellgetcontext_(PC *pc,void **ctx,PetscErrorCode *ierr) 67 { 68 *ierr = PCShellGetContext(*pc,ctx); 69 } 70 71 void PETSC_STDCALL pcshellsetapply_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*),PetscErrorCode *ierr) 72 { 73 PetscObjectAllocateFortranPointers(*pc,5); 74 ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFunction)apply; 75 *ierr = PCShellSetApply(*pc,ourshellapply); 76 } 77 78 void PETSC_STDCALL pcshellsetapplyrichardson_(PC *pc,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,Vec *,PetscReal*,PetscReal*,PetscReal*,PetscInt*,PetscInt*,PCRichardsonConvergedReason*,PetscErrorCode*),PetscErrorCode *ierr) 79 { 80 PetscObjectAllocateFortranPointers(*pc,5); 81 ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscVoidFunction)apply; 82 *ierr = PCShellSetApplyRichardson(*pc,ourapplyrichardson); 83 } 84 85 void PETSC_STDCALL pcshellsetapplytranspose_(PC *pc,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), PetscErrorCode *ierr) 86 { 87 PetscObjectAllocateFortranPointers(*pc,5); 88 ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFunction)applytranspose; 89 *ierr = PCShellSetApplyTranspose(*pc,ourshellapplytranspose); 90 } 91 92 void PETSC_STDCALL pcshellsetsetup_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 93 { 94 PetscObjectAllocateFortranPointers(*pc,5); 95 ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFunction)setup; 96 *ierr = PCShellSetSetUp(*pc,ourshellsetup); 97 } 98 99 void PETSC_STDCALL pcshellsetdestroy_(PC *pc,void (PETSC_STDCALL *setup)(void*,PetscErrorCode*),PetscErrorCode *ierr) 100 { 101 PetscObjectAllocateFortranPointers(*pc,5); 102 ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFunction)setup; 103 *ierr = PCShellSetDestroy(*pc,ourshelldestroy); 104 } 105 106 void PETSC_STDCALL pcshellsetname_(PC *pc,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 107 { 108 char *c; 109 FIXCHAR(name,len,c); 110 *ierr = PCShellSetName(*pc,c); 111 FREECHAR(name,c); 112 } 113 114 /* -----------------------------------------------------------------*/ 115 116 EXTERN_C_END 117