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