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