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: }