1 #include "zpetsc.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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define matfdcoloringsetfunctionts_ matfdcoloringsetfunctionts 10 #define matfdcoloringsetfunctionsnes_ matfdcoloringsetfunctionsnes 11 #endif 12 13 EXTERN_C_BEGIN 14 static void (PETSC_STDCALL *f7)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*); 15 static void (PETSC_STDCALL *f8)(SNES*,Vec*,Vec*,void*,PetscErrorCode*); 16 EXTERN_C_END 17 18 /* These are not extern C because they are passed into non-extern C user level functions */ 19 static PetscErrorCode ourmatfdcoloringfunctionts(TS ts,double t,Vec x,Vec y,void *ctx) 20 { 21 PetscErrorCode ierr = 0; 22 (*f7)(&ts,&t,&x,&y,ctx,&ierr); 23 return ierr; 24 } 25 26 static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES ts,Vec x,Vec y,void *ctx) 27 { 28 PetscErrorCode ierr = 0; 29 (*f8)(&ts,&x,&y,ctx,&ierr); 30 return ierr; 31 } 32 33 EXTERN_C_BEGIN 34 35 /* 36 MatFDColoringSetFunction sticks the Fortran function into the fortran_func_pointers 37 this function is then accessed by ourmatfdcoloringfunction() 38 39 NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently. 40 41 USER CAN HAVE ONLY ONE MatFDColoring in code Because there is no place to hang f7! 42 */ 43 44 45 void PETSC_STDCALL matfdcoloringsetfunctionts_(MatFDColoring *fd,void (PETSC_STDCALL *f)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*), 46 void *ctx,PetscErrorCode *ierr) 47 { 48 f7 = f; 49 *ierr = MatFDColoringSetFunction(*fd,(FCNINTVOID)ourmatfdcoloringfunctionts,ctx); 50 } 51 52 void PETSC_STDCALL matfdcoloringsetfunctionsnes_(MatFDColoring *fd,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec*,void*,PetscErrorCode*), 53 void *ctx,PetscErrorCode *ierr) 54 { 55 f8 = f; 56 *ierr = MatFDColoringSetFunction(*fd,(FCNINTVOID)ourmatfdcoloringfunctionsnes,ctx); 57 } 58 59 EXTERN_C_END 60