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