1 #include "private/fortranimpl.h" 2 #include "private/matimpl.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 16 /* These are not extern C because they are passed into non-extern C user level functions */ 17 static PetscErrorCode ourmatfdcoloringfunctionts(TS ts,PetscReal t,Vec x,Vec y,MatFDColoring fd) 18 { 19 PetscErrorCode ierr = 0; 20 (*(void (PETSC_STDCALL *)(TS*,PetscReal*,Vec*,Vec*,void*,PetscErrorCode*))(fd->ftn_func_pointer)) (&ts,&t,&x,&y,fd->ftn_func_cntx,&ierr); 21 return ierr; 22 } 23 24 static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES snes,Vec x,Vec y,MatFDColoring fd) 25 { 26 PetscErrorCode ierr = 0; 27 (*(void (PETSC_STDCALL *)(SNES*,Vec*,Vec*,void*,PetscErrorCode*))(fd->ftn_func_pointer)) (&snes,&x,&y,fd->ftn_func_cntx,&ierr); 28 return ierr; 29 } 30 31 EXTERN_C_BEGIN 32 33 /* 34 MatFDColoringSetFunction sticks the Fortran function and its context into the MatFDColoring structure and passes the MatFDColoring object 35 in as the function context. ourmafdcoloringfunctionsnes() and ourmatfdcoloringfunctionts() then access the function and its context from the 36 MatFDColoring that is passed in. This is the same way that fortran_func_pointers is used in PETSc objects. 37 38 NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently. 39 */ 40 41 42 void PETSC_STDCALL matfdcoloringsetfunctionts_(MatFDColoring *fd,void (PETSC_STDCALL *f)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 43 { 44 (*fd)->ftn_func_pointer = (void*) f; 45 (*fd)->ftn_func_cntx = ctx; 46 *ierr = MatFDColoringSetFunction(*fd,(PetscErrorCodeFunction)ourmatfdcoloringfunctionts,*fd); 47 } 48 49 void PETSC_STDCALL matfdcoloringsetfunction_(MatFDColoring *fd,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr) 50 { 51 (*fd)->ftn_func_pointer = (void*) f; 52 (*fd)->ftn_func_cntx = ctx; 53 *ierr = MatFDColoringSetFunction(*fd,(PetscErrorCodeFunction)ourmatfdcoloringfunctionsnes,*fd); 54 } 55 56 void PETSC_STDCALL matfdcoloringview_(MatFDColoring *c,PetscViewer *vin,PetscErrorCode *ierr) 57 { 58 PetscViewer v; 59 60 PetscPatchDefaultViewers_Fortran(vin,v); 61 *ierr = MatFDColoringView(*c,v); 62 } 63 64 65 EXTERN_C_END 66