1 #include <petsc-private/fortranimpl.h> 2 #include <petscdmshell.h> /*I "petscdmshell.h" I*/ 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define dmshellsetcreatematrix_ DMSHELLSETCREATEMATRIX 6 #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_ 7 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8 #define dmshellsetcreatematrix_ dmshellsetcreatematrix 9 #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector 10 #endif 11 12 /* 13 C routines are required for matrix and global vector creation. 14 We define C routines here that call the corresponding Fortran routine (stashed 15 in dm->fortran_func_pointers) that was set by the user. 16 17 dm->fortran_func_pointers usage: 18 19 0: ourcreatematrix 20 1: ourcreateglobalvector 21 */ 22 23 static PetscErrorCode ourcreatematrix(DM dm,MatType type,Mat *A) 24 { 25 PetscErrorCode ierr = 0; 26 (*(PetscErrorCode (PETSC_STDCALL *)(DM*,MatType*,Mat*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[0]))(&dm,&type,A,&ierr); 27 return ierr; 28 } 29 30 static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 31 { 32 PetscErrorCode ierr = 0; 33 (*(PetscErrorCode (PETSC_STDCALL *)(DM*,Vec*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[1]))(&dm,v,&ierr); 34 return ierr; 35 } 36 37 EXTERN_C_BEGIN 38 39 void PETSC_STDCALL dmshellsetcreatematrix_(DM *dm,void (PETSC_STDCALL *func)(DM*,MatType*,Mat*,PetscErrorCode*),PetscErrorCode *ierr) 40 { 41 PetscObjectAllocateFortranPointers(*dm,2); 42 ((PetscObject)*dm)->fortran_func_pointers[0] = (PetscVoidFunction) func; 43 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 44 } 45 46 void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 47 { 48 PetscObjectAllocateFortranPointers(*dm,2); 49 ((PetscObject)*dm)->fortran_func_pointers[1] = (PetscVoidFunction) func; 50 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 51 } 52 53 EXTERN_C_END 54