1 #include <petsc-private/fortranimpl.h> 2 #include <petscdm.h> 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define dmview_ DMVIEW 6 #define dmcreatecoloring_ DMCREATECOLORING 7 #define dmsetfunction_ DMSETFUNCTION 8 #define dmsetjacobian_ DMSETJACOBIAN 9 #define dmcreatematrix_ DMCREATEMATRIX 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define dmview_ dmview 12 #define dmcreatecoloring_ dmcreatecoloring 13 #define dmsetfunction_ dmsetfunction 14 #define dmsetjacobian_ dmsetjacobian 15 #define dmcreatematrix_ dmcreatematrix 16 #endif 17 18 static PetscErrorCode ourdmfunction(DM dm,Vec x,Vec b) 19 { 20 PetscErrorCode ierr = 0; 21 (*(void (PETSC_STDCALL *)(DM*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[1]))(&dm,&x,&b,&ierr);CHKERRQ(ierr); 22 return 0; 23 } 24 25 static PetscErrorCode ourdmjacobian(DM dm,Vec x,Mat A,Mat B,MatStructure *str) 26 { 27 PetscErrorCode ierr = 0; 28 (*(void (PETSC_STDCALL *)(DM*,Vec*,Mat*,Mat*,MatStructure*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[2]))(&dm,&x,&A,&B,str,&ierr);CHKERRQ(ierr); 29 return 0; 30 } 31 32 33 EXTERN_C_BEGIN 34 void PETSC_STDCALL dmsetfunction_(DM *dm,PetscErrorCode (*f)(DM*,Vec*,Vec*,PetscErrorCode*), int *ierr ) 35 { 36 PetscObjectAllocateFortranPointers(*dm,12); 37 ((PetscObject)*dm)->fortran_func_pointers[1] = (PetscVoidFunction)f; 38 *ierr = DMSetFunction(*dm,ourdmfunction); 39 } 40 EXTERN_C_END 41 42 EXTERN_C_BEGIN 43 void PETSC_STDCALL dmsetjacobian_(DM *dm,PetscErrorCode (*f)(DM*,Vec*,Mat*,Mat*,MatStructure*,PetscErrorCode*), int *ierr ) 44 { 45 PetscObjectAllocateFortranPointers(*dm,12); 46 ((PetscObject)*dm)->fortran_func_pointers[2] = (PetscVoidFunction)f; 47 *ierr = DMSetJacobian(*dm,ourdmjacobian); 48 } 49 EXTERN_C_END 50 51 EXTERN_C_BEGIN 52 void PETSC_STDCALL dmcreatecoloring_(DM *dm,ISColoringType *ctype, CHAR mtype PETSC_MIXED_LEN(len),ISColoring *coloring, int *ierr PETSC_END_LEN(len)) 53 { 54 char *t; 55 56 FIXCHAR(mtype,len,t); 57 *ierr = DMCreateColoring(*dm,*ctype,t,coloring); 58 FREECHAR(mtype,t); 59 } 60 EXTERN_C_END 61 62 EXTERN_C_BEGIN 63 void PETSC_STDCALL dmview_(DM *da,PetscViewer *vin,PetscErrorCode *ierr) 64 { 65 PetscViewer v; 66 PetscPatchDefaultViewers_Fortran(vin,v); 67 *ierr = DMView(*da,v); 68 } 69 EXTERN_C_END 70 71 EXTERN_C_BEGIN 72 void PETSC_STDCALL dmcreatematrix_(DM *dm,CHAR mat_type PETSC_MIXED_LEN(len),Mat *J,PetscErrorCode *ierr PETSC_END_LEN(len)) 73 { 74 char *t; 75 FIXCHAR(mat_type,len,t); 76 *ierr = DMCreateMatrix(*dm,t,J); 77 FREECHAR(mat_type,t); 78 } 79 EXTERN_C_END 80