Actual source code: zfdmatrixf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petsc/private/matimpl.h>
4: /* Declare these pointer types instead of void* for clarity, but do not include petscts.h so that this code does have an actual reverse dependency. */
5: typedef struct _p_TS *TS;
6: typedef struct _p_SNES *SNES;
8: #if defined(PETSC_HAVE_FORTRAN_CAPS)
9: #define matfdcoloringsetfunctionts_ MATFDCOLORINGSETFUNCTIONTS
10: #define matfdcoloringsetfunction_ MATFDCOLORINGSETFUNCTION
11: #define matfdcoloringgetperturbedcolumns_ MATFDCOLORINGGETPERTURBEDCOLUMNS
12: #define matfdcoloringrestoreperturbedcolumns_ MATFDCOLORINGRESTOREPERTURBEDCOLUMNS
13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
14: #define matfdcoloringsetfunctionts_ matfdcoloringsetfunctionts
15: #define matfdcoloringsetfunction_ matfdcoloringsetfunction
16: #define matfdcoloringgetperturbedcolumns_ matfdcoloringgetperturbedcolumns
17: #define matfdcoloringrestoreperturbedcolumns_ matfdcoloringrestoreperturbedcolumns
18: #endif
20: PETSC_EXTERN void matfdcoloringgetperturbedcolumns_(MatFDColoring *x, PetscInt *len, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
21: {
22: const PetscInt *fa;
24: *__ierr = MatFDColoringGetPerturbedColumns(*x, len, &fa);
25: if (*__ierr) return;
26: *__ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, *len, ptr PETSC_F90_2PTR_PARAM(ptrd));
27: }
28: PETSC_EXTERN void matfdcoloringrestoreperturbedcolumns_(MatFDColoring *x, PetscInt *len, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
29: {
30: *__ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
31: }
33: /* These are not extern C because they are passed into non-extern C user level functions */
34: static PetscErrorCode ourmatfdcoloringfunctionts(TS ts, PetscReal t, Vec x, Vec y, MatFDColoring fd)
35: {
36: PetscErrorCode ierr = PETSC_SUCCESS;
37: (*(void (*)(TS *, PetscReal *, Vec *, Vec *, void *, PetscErrorCode *))fd->ftn_func_pointer)(&ts, &t, &x, &y, fd->ftn_func_cntx, &ierr);
38: return ierr;
39: }
41: static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES snes, Vec x, Vec y, MatFDColoring fd)
42: {
43: PetscErrorCode ierr = PETSC_SUCCESS;
44: (*(void (*)(SNES *, Vec *, Vec *, void *, PetscErrorCode *))fd->ftn_func_pointer)(&snes, &x, &y, fd->ftn_func_cntx, &ierr);
45: return ierr;
46: }
48: /*
49: MatFDColoringSetFunction sticks the Fortran function and its context into the MatFDColoring structure and passes the MatFDColoring object
50: in as the function context. ourmafdcoloringfunctionsnes() and ourmatfdcoloringfunctionts() then access the function and its context from the
51: MatFDColoring that is passed in. This is the same way that fortran_func_pointers is used in PETSc objects.
53: NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently.
54: */
56: PETSC_EXTERN void matfdcoloringsetfunctionts_(MatFDColoring *fd, void (*f)(TS *, double *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
57: {
58: (*fd)->ftn_func_pointer = (void (*)(void))f;
59: (*fd)->ftn_func_cntx = ctx;
61: *ierr = MatFDColoringSetFunction(*fd, (PetscErrorCodeFn *)ourmatfdcoloringfunctionts, *fd);
62: }
64: PETSC_EXTERN void matfdcoloringsetfunction_(MatFDColoring *fd, void (*f)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
65: {
66: (*fd)->ftn_func_pointer = (void (*)(void))f;
67: (*fd)->ftn_func_cntx = ctx;
69: *ierr = MatFDColoringSetFunction(*fd, (PetscErrorCodeFn *)ourmatfdcoloringfunctionsnes, *fd);
70: }