Actual source code: zfdmatrixf.c
1: #include <petsc/private/f90impl.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 matfdcoloringgetperturbedcolumnsf90_ MATFDCOLORINGGETPERTURBEDCOLUMNSF90
12: #define matfdcoloringrestoreperturbedcolumnsf90_ MATFDCOLORINGRESTOREPERTURBEDCOLUMNSF90
13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
14: #define matfdcoloringsetfunctionts_ matfdcoloringsetfunctionts
15: #define matfdcoloringsetfunction_ matfdcoloringsetfunction
16: #define matfdcoloringgetperturbedcolumnsf90_ matfdcoloringgetperturbedcolumnsf90
17: #define matfdcoloringrestoreperturbedcolumnsf90_ matfdcoloringrestoreperturbedcolumnsf90
18: #endif
20: PETSC_EXTERN void matfdcoloringgetperturbedcolumnsf90_(MatFDColoring *x, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
21: {
22: const PetscInt *fa;
23: PetscInt len;
25: *__ierr = MatFDColoringGetPerturbedColumns(*x, &len, &fa);
26: if (*__ierr) return;
27: *__ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
28: }
29: PETSC_EXTERN void matfdcoloringrestoreperturbedcolumnsf90_(MatFDColoring *x, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
30: {
31: *__ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
32: }
34: /* These are not extern C because they are passed into non-extern C user level functions */
35: static PetscErrorCode ourmatfdcoloringfunctionts(TS ts, PetscReal t, Vec x, Vec y, MatFDColoring fd)
36: {
37: PetscErrorCode ierr = PETSC_SUCCESS;
38: (*(void (*)(TS *, PetscReal *, Vec *, Vec *, void *, PetscErrorCode *))fd->ftn_func_pointer)(&ts, &t, &x, &y, fd->ftn_func_cntx, &ierr);
39: return ierr;
40: }
42: static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES snes, Vec x, Vec y, MatFDColoring fd)
43: {
44: PetscErrorCode ierr = PETSC_SUCCESS;
45: (*(void (*)(SNES *, Vec *, Vec *, void *, PetscErrorCode *))fd->ftn_func_pointer)(&snes, &x, &y, fd->ftn_func_cntx, &ierr);
46: return ierr;
47: }
49: /*
50: MatFDColoringSetFunction sticks the Fortran function and its context into the MatFDColoring structure and passes the MatFDColoring object
51: in as the function context. ourmafdcoloringfunctionsnes() and ourmatfdcoloringfunctionts() then access the function and its context from the
52: MatFDColoring that is passed in. This is the same way that fortran_func_pointers is used in PETSc objects.
54: NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently.
55: */
57: PETSC_EXTERN void matfdcoloringsetfunctionts_(MatFDColoring *fd, void (*f)(TS *, double *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
58: {
59: (*fd)->ftn_func_pointer = (void (*)(void))f;
60: (*fd)->ftn_func_cntx = ctx;
62: *ierr = MatFDColoringSetFunction(*fd, (PetscErrorCodeFn *)ourmatfdcoloringfunctionts, *fd);
63: }
65: PETSC_EXTERN void matfdcoloringsetfunction_(MatFDColoring *fd, void (*f)(SNES *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
66: {
67: (*fd)->ftn_func_pointer = (void (*)(void))f;
68: (*fd)->ftn_func_cntx = ctx;
70: *ierr = MatFDColoringSetFunction(*fd, (PetscErrorCodeFn *)ourmatfdcoloringfunctionsnes, *fd);
71: }