1 #include "private/fortranimpl.h" 2 #include "petscmat.h" 3 #include "petscts.h" 4 5 #if defined(PETSC_HAVE_FORTRAN_CAPS) 6 #define matfdcoloringsetfunctionts_ MATFDCOLORINGSETFUNCTIONTS 7 #define matfdcoloringsetfunctionsnes_ MATFDCOLORINGSETFUNCTIONSNES 8 #define matfdcoloringview_ MATFDCOLORINGVIEW 9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 10 #define matfdcoloringsetfunctionts_ matfdcoloringsetfunctionts 11 #define matfdcoloringsetfunctionsnes_ matfdcoloringsetfunctionsnes 12 #define matfdcoloringview_ matfdcoloringview 13 #endif 14 15 EXTERN_C_BEGIN 16 static void (PETSC_STDCALL *f7)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*); 17 static void (PETSC_STDCALL *f8)(SNES*,Vec*,Vec*,void*,PetscErrorCode*); 18 EXTERN_C_END 19 20 /* These are not extern C because they are passed into non-extern C user level functions */ 21 static PetscErrorCode ourmatfdcoloringfunctionts(TS ts,double t,Vec x,Vec y,void *ctx) 22 { 23 PetscErrorCode ierr = 0; 24 (*f7)(&ts,&t,&x,&y,ctx,&ierr); 25 return ierr; 26 } 27 28 static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES ts,Vec x,Vec y,void *ctx) 29 { 30 PetscErrorCode ierr = 0; 31 (*f8)(&ts,&x,&y,ctx,&ierr); 32 return ierr; 33 } 34 35 EXTERN_C_BEGIN 36 37 /* 38 MatFDColoringSetFunction sticks the Fortran function into the fortran_func_pointers 39 this function is then accessed by ourmatfdcoloringfunction() 40 41 NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently. 42 43 USER CAN HAVE ONLY ONE MatFDColoring in code Because there is no place to hang f7! 44 */ 45 46 47 void PETSC_STDCALL matfdcoloringsetfunctionts_(MatFDColoring *fd,void (PETSC_STDCALL *f)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*), 48 void *ctx,PetscErrorCode *ierr) 49 { 50 f7 = f; 51 *ierr = MatFDColoringSetFunction(*fd,(PetscErrorCodeFunction)ourmatfdcoloringfunctionts,ctx); 52 } 53 54 void PETSC_STDCALL matfdcoloringsetfunctionsnes_(MatFDColoring *fd,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec*,void*,PetscErrorCode*), 55 void *ctx,PetscErrorCode *ierr) 56 { 57 f8 = f; 58 *ierr = MatFDColoringSetFunction(*fd,(PetscErrorCodeFunction)ourmatfdcoloringfunctionsnes,ctx); 59 } 60 61 void PETSC_STDCALL matfdcoloringview_(MatFDColoring *c,PetscViewer *vin,PetscErrorCode *ierr) 62 { 63 PetscViewer v; 64 65 PetscPatchDefaultViewers_Fortran(vin,v); 66 *ierr = MatFDColoringView(*c,v); 67 } 68 69 70 EXTERN_C_END 71