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