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