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