xref: /petsc/src/sys/ftn-custom/f90_cwrap.c (revision 834855d6effb0d027771461c8e947ee1ce5a1e17)

#include <petsc/private/ftnimpl.h>

/*@C
   PetscMPIFortranDatatypeToC - Converts a `MPI_Fint` that contains a Fortran `MPI_Datatype` to its C `MPI_Datatype` equivalent

   Not Collective, No Fortran Support

   Input Parameter:
.  unit - The Fortran `MPI_Datatype`

   Output Parameter:
.  dtype - the corresponding C `MPI_Datatype`

   Level: developer

   Developer Note:
   The MPI documentation in multiple places says that one can never us
   Fortran `MPI_Datatype`s in C (or vice-versa) but this is problematic since users could never
   call C routines from Fortran that have `MPI_Datatype` arguments. Jed states that the Fortran
   `MPI_Datatype`s will always be available in C if the MPI was built to support Fortran. This function
   relies on this.

.seealso: `MPI_Fint`, `MPI_Datatype`
@*/
PetscErrorCode PetscMPIFortranDatatypeToC(MPI_Fint unit, MPI_Datatype *dtype)
{
  MPI_Datatype ftype;

  PetscFunctionBegin;
  ftype = MPI_Type_f2c(unit);
  if (ftype == MPI_INTEGER || ftype == MPI_INT) *dtype = MPI_INT;
  else if (ftype == MPI_INTEGER8 || ftype == MPIU_INT64) *dtype = MPIU_INT64;
  else if (ftype == MPI_DOUBLE_PRECISION || ftype == MPI_DOUBLE) *dtype = MPI_DOUBLE;
  else if (ftype == MPI_FLOAT) *dtype = MPI_FLOAT;
#if defined(PETSC_HAVE_COMPLEX)
  else if (ftype == MPI_COMPLEX16 || ftype == MPI_C_DOUBLE_COMPLEX) *dtype = MPI_C_DOUBLE_COMPLEX;
#endif
#if defined(PETSC_HAVE_REAL___FLOAT128)
  else if (ftype == MPIU___FLOAT128) *dtype = MPIU___FLOAT128;
#endif
  else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unknown Fortran MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*************************************************************************/

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array1dcreatescalar_       F90ARRAY1DCREATESCALAR
  #define f90array1daccessscalar_       F90ARRAY1DACCESSSCALAR
  #define f90array1ddestroyscalar_      F90ARRAY1DDESTROYSCALAR
  #define f90array1dcreatereal_         F90ARRAY1DCREATEREAL
  #define f90array1daccessreal_         F90ARRAY1DACCESSREAL
  #define f90array1ddestroyreal_        F90ARRAY1DDESTROYREAL
  #define f90array1dcreateint_          F90ARRAY1DCREATEINT
  #define f90array1daccessint_          F90ARRAY1DACCESSINT
  #define f90array1ddestroyint_         F90ARRAY1DDESTROYINT
  #define f90array1dcreatempiint_       F90ARRAY1DCREATEMPIINT
  #define f90array1daccessmpiint_       F90ARRAY1DACCESSMPIINT
  #define f90array1ddestroympiint_      F90ARRAY1DDESTROYMPIINT
  #define f90array1dcreatefortranaddr_  F90ARRAY1DCREATEFORTRANADDR
  #define f90array1daccessfortranaddr_  F90ARRAY1DACCESSFORTRANADDR
  #define f90array1ddestroyfortranaddr_ F90ARRAY1DDESTROYFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array1dcreatescalar_       f90array1dcreatescalar
  #define f90array1daccessscalar_       f90array1daccessscalar
  #define f90array1ddestroyscalar_      f90array1ddestroyscalar
  #define f90array1dcreatereal_         f90array1dcreatereal
  #define f90array1daccessreal_         f90array1daccessreal
  #define f90array1ddestroyreal_        f90array1ddestroyreal
  #define f90array1dcreateint_          f90array1dcreateint
  #define f90array1daccessint_          f90array1daccessint
  #define f90array1ddestroyint_         f90array1ddestroyint
  #define f90array1dcreatempiint_       f90array1dcreatempiint
  #define f90array1daccessmpiint_       f90array1daccessmpiint
  #define f90array1ddestroympiint_      f90array1ddestroympiint
  #define f90array1dcreatefortranaddr_  f90array1dcreatefortranaddr
  #define f90array1daccessfortranaddr_  f90array1daccessfortranaddr
  #define f90array1ddestroyfortranaddr_ f90array1ddestroyfortranaddr
#endif

PETSC_EXTERN void f90array1dcreatescalar_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1daccessscalar_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1ddestroyscalar_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1dcreatereal_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1daccessreal_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1ddestroyreal_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1dcreateint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1daccessint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1ddestroyint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1dcreatempiint_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1daccessmpiint_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1ddestroympiint_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1dcreatefortranaddr_(void *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1daccessfortranaddr_(F90Array1d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array1ddestroyfortranaddr_(F90Array1d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

/*@C
   F90Array1dCreate - given a `F90Array1d` passed from Fortran associate with it a C array, its starting index and length

   Not Collective, No Fortran Support

   Input Parameters:
+  array - the C address pointer
.  type  - the MPI datatype of the array
.  start - the first index of the array
.  len   - the length of the array
.  ptr   - the `F90Array1d` passed from Fortran
-  ptrd   - an extra pointer passed by some Fortran compilers

   Level: developer

   Developer Notes:
   This is used in PETSc Fortran stubs that are used to pass C arrays to Fortran, for example `VecGetArray()`

   This doesn't actually create the `F90Array1d()`, it just associates a C pointer with it.

   There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

.seealso: `F90Array1d`, `F90Array1dAccess()`, `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
@*/
PetscErrorCode F90Array1dCreate(void *array, MPI_Datatype type, PetscInt start, PetscInt len, F90Array1d *ptr PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    if (!len) array = PETSC_NULL_SCALAR_Fortran;
    f90array1dcreatescalar_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    if (!len) array = PETSC_NULL_REAL_Fortran;
    f90array1dcreatereal_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    if (!len) array = PETSC_NULL_INTEGER_Fortran;
    f90array1dcreateint_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPI_INT) {
    /* PETSC_NULL_MPIINT_Fortran is not needed since there is no PETSc APIs allowing NULL in place of 'PetscMPIInt *' arguments.
       At this line, we only need to assign 'array' a valid address when len is 0, thus PETSC_NULL_INTEGER_Fortran is enough.
    */
    if (!len) array = PETSC_NULL_INTEGER_Fortran;
    f90array1dcreatempiint_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array1dcreatefortranaddr_(array, &start, &len, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
   F90Array1dAccess - given a `F90Array1d` passed from Fortran, accesses from it the associate C array that was provided with `F90Array1dCreate()`

   Not Collective, No Fortran Support

   Input Parameters:
+  ptr   - the `F90Array1d` passed from Fortran
.  type  - the MPI datatype of the array
-  ptrd   - an extra pointer passed by some Fortran compilers

   Output Parameter:
.  array - the C address pointer

   Level: developer

   Developer Note:
   This is used in PETSc Fortran stubs that access C arrays inside Fortran pointer arrays to Fortran. It is usually used in `XXXRestore()`` Fortran stubs.

   There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

.seealso: `F90Array1d`, `F90Array1dCreate()`, `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
@*/
PetscErrorCode F90Array1dAccess(F90Array1d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array1daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
    if (*array == PETSC_NULL_SCALAR_Fortran) *array = NULL;
  } else if (type == MPIU_REAL) {
    f90array1daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
    if (*array == PETSC_NULL_REAL_Fortran) *array = NULL;
  } else if (type == MPIU_INT) {
    f90array1daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
    if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
  } else if (type == MPI_INT) {
    f90array1daccessmpiint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
    if (*array == PETSC_NULL_INTEGER_Fortran) *array = NULL;
  } else if (type == MPIU_FORTRANADDR) {
    f90array1daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*@C
   F90Array1dDestroy - given a `F90Array1d` passed from Fortran removes the C array associate with it with `F90Array1dCreate()`

   Not Collective, No Fortran Support

   Input Parameters:
+  ptr   - the `F90Array1d` passed from Fortran
.  type  - the MPI datatype of the array
-  ptrd   - an extra pointer passed by some Fortran compilers

   Level: developer

   Developer Notes:
   This is used in PETSc Fortran stubs that are used to end access to C arrays from Fortran, for example `VecRestoreArray()`

   This doesn't actually destroy the `F90Array1d()`, it just removes the associated C pointer from it.

   There are equivalent routines for 2, 3, and 4 dimensional Fortran arrays.

.seealso: `F90Array1d`, `F90Array1dAccess()`, `F90Array1dCreate()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
@*/
PetscErrorCode F90Array1dDestroy(F90Array1d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array1ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array1ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array1ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPI_INT) {
    f90array1ddestroympiint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array1ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

/*MC
   F90Array1d - a PETSc C representation of a Fortran `XXX, pointer :: array(:)` object

   Not Collective, No Fortran Support

   Level: developer

   Developer Notes:
   This is used in PETSc Fortran stubs that are used to control access to C arrays from Fortran, for example `VecGetArray()`

   PETSc does not require any information about the format of this object, all operations on the object are performed by calling Fortran routines.

   There are equivalent objects for 2, 3, and 4 dimensional Fortran arrays.

.seealso: `F90Array1dAccess()`, `F90Array1dCreate()`, , `F90Array1dDestroy()`, `F90Array2dCreate()`, `F90Array2dAccess()`, `F90Array2dDestroy()`
M*/

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array2dcreatescalar_       F90ARRAY2DCREATESCALAR
  #define f90array2daccessscalar_       F90ARRAY2DACCESSSCALAR
  #define f90array2ddestroyscalar_      F90ARRAY2DDESTROYSCALAR
  #define f90array2dcreatereal_         F90ARRAY2DCREATEREAL
  #define f90array2daccessreal_         F90ARRAY2DACCESSREAL
  #define f90array2ddestroyreal_        F90ARRAY2DDESTROYREAL
  #define f90array2dcreateint_          F90ARRAY2DCREATEINT
  #define f90array2daccessint_          F90ARRAY2DACCESSINT
  #define f90array2ddestroyint_         F90ARRAY2DDESTROYINT
  #define f90array2dcreatefortranaddr_  F90ARRAY2DCREATEFORTRANADDR
  #define f90array2daccessfortranaddr_  F90ARRAY2DACCESSFORTRANADDR
  #define f90array2ddestroyfortranaddr_ F90ARRAY2DDESTROYFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array2dcreatescalar_       f90array2dcreatescalar
  #define f90array2daccessscalar_       f90array2daccessscalar
  #define f90array2ddestroyscalar_      f90array2ddestroyscalar
  #define f90array2dcreatereal_         f90array2dcreatereal
  #define f90array2daccessreal_         f90array2daccessreal
  #define f90array2ddestroyreal_        f90array2ddestroyreal
  #define f90array2dcreateint_          f90array2dcreateint
  #define f90array2daccessint_          f90array2daccessint
  #define f90array2ddestroyint_         f90array2ddestroyint
  #define f90array2dcreatefortranaddr_  f90array2dcreatefortranaddr
  #define f90array2daccessfortranaddr_  f90array2daccessfortranaddr
  #define f90array2ddestroyfortranaddr_ f90array2ddestroyfortranaddr
#endif

PETSC_EXTERN void f90array2dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2daccessscalar_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2ddestroyscalar_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2daccessreal_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2ddestroyreal_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2daccessint_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2ddestroyint_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array2d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2daccessfortranaddr_(F90Array2d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array2ddestroyfortranaddr_(F90Array2d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

PetscErrorCode F90Array2dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, F90Array2d *ptr PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array2dcreatescalar_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array2dcreatereal_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array2dcreateint_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array2dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array2dAccess(F90Array2d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array2daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array2daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array2daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array2daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array2dDestroy(F90Array2d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array2ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array2ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array2ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array2ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array3dcreatescalar_       F90ARRAY3DCREATESCALAR
  #define f90array3daccessscalar_       F90ARRAY3DACCESSSCALAR
  #define f90array3ddestroyscalar_      F90ARRAY3DDESTROYSCALAR
  #define f90array3dcreatereal_         F90ARRAY3DCREATEREAL
  #define f90array3daccessreal_         F90ARRAY3DACCESSREAL
  #define f90array3ddestroyreal_        F90ARRAY3DDESTROYREAL
  #define f90array3dcreateint_          F90ARRAY3DCREATEINT
  #define f90array3daccessint_          F90ARRAY3DACCESSINT
  #define f90array3ddestroyint_         F90ARRAY3DDESTROYINT
  #define f90array3dcreatefortranaddr_  F90ARRAY3DCREATEFORTRANADDR
  #define f90array3daccessfortranaddr_  F90ARRAY3DACCESSFORTRANADDR
  #define f90array3ddestroyfortranaddr_ F90ARRAY3DDESTROYFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array3dcreatescalar_       f90array3dcreatescalar
  #define f90array3daccessscalar_       f90array3daccessscalar
  #define f90array3ddestroyscalar_      f90array3ddestroyscalar
  #define f90array3dcreatereal_         f90array3dcreatereal
  #define f90array3daccessreal_         f90array3daccessreal
  #define f90array3ddestroyreal_        f90array3ddestroyreal
  #define f90array3dcreateint_          f90array3dcreateint
  #define f90array3daccessint_          f90array3daccessint
  #define f90array3ddestroyint_         f90array3ddestroyint
  #define f90array3dcreatefortranaddr_  f90array3dcreatefortranaddr
  #define f90array3daccessfortranaddr_  f90array3daccessfortranaddr
  #define f90array3ddestroyfortranaddr_ f90array3ddestroyfortranaddr
#endif

PETSC_EXTERN void f90array3dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3daccessscalar_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3ddestroyscalar_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3daccessreal_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3ddestroyreal_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3daccessint_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3ddestroyint_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array3d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3daccessfortranaddr_(F90Array3d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array3ddestroyfortranaddr_(F90Array3d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

PetscErrorCode F90Array3dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, PetscInt start3, PetscInt len3, F90Array3d *ptr PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array3dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array3dcreatereal_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array3dcreateint_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array3dcreatefortranaddr_(array, &start1, &len1, &start2, &len2, &start3, &len3, ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array3dAccess(F90Array3d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array3daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array3daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array3daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array3daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array3dDestroy(F90Array3d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array3ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array3ddestroyreal_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array3ddestroyint_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array3ddestroyfortranaddr_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array4dcreatescalar_       F90ARRAY4DCREATESCALAR
  #define f90array4daccessscalar_       F90ARRAY4DACCESSSCALAR
  #define f90array4ddestroyscalar_      F90ARRAY4DDESTROYSCALAR
  #define f90array4dcreatereal_         F90ARRAY4DCREATEREAL
  #define f90array4daccessreal_         F90ARRAY4DACCESSREAL
  #define f90array4ddestroyreal_        F90ARRAY4DDESTROYREAL
  #define f90array4dcreateint_          F90ARRAY4DCREATEINT
  #define f90array4daccessint_          F90ARRAY4DACCESSINT
  #define f90array4ddestroyint_         F90ARRAY4DDESTROYINT
  #define f90array4dcreatefortranaddr_  F90ARRAY4DCREATEFORTRANADDR
  #define f90array4daccessfortranaddr_  F90ARRAY4DACCESSFORTRANADDR
  #define f90array4ddestroyfortranaddr_ F90ARRAY4DDESTROYFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array4dcreatescalar_       f90array4dcreatescalar
  #define f90array4daccessscalar_       f90array4daccessscalar
  #define f90array4ddestroyscalar_      f90array4ddestroyscalar
  #define f90array4dcreatereal_         f90array4dcreatereal
  #define f90array4daccessreal_         f90array4daccessreal
  #define f90array4ddestroyreal_        f90array4ddestroyreal
  #define f90array4dcreateint_          f90array4dcreateint
  #define f90array4daccessint_          f90array4daccessint
  #define f90array4ddestroyint_         f90array4ddestroyint
  #define f90array4dcreatefortranaddr_  f90array4dcreatefortranaddr
  #define f90array4daccessfortranaddr_  f90array4daccessfortranaddr
  #define f90array4ddestroyfortranaddr_ f90array4ddestroyfortranaddr
#endif

PETSC_EXTERN void f90array4dcreatescalar_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4daccessscalar_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4ddestroyscalar_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4dcreatereal_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4daccessreal_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4ddestroyreal_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4dcreateint_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4daccessint_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4ddestroyint_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4dcreatefortranaddr_(void *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, PetscInt *, F90Array4d *PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4daccessfortranaddr_(F90Array4d *, void **PETSC_F90_2PTR_PROTO_NOVAR);
PETSC_EXTERN void f90array4ddestroyfortranaddr_(F90Array4d *ptr PETSC_F90_2PTR_PROTO_NOVAR);

PetscErrorCode F90Array4dCreate(void *array, MPI_Datatype type, PetscInt start1, PetscInt len1, PetscInt start2, PetscInt len2, PetscInt start3, PetscInt len3, PetscInt start4, PetscInt len4, F90Array4d *ptr PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  f90array4dcreatescalar_(array, &start1, &len1, &start2, &len2, &start3, &len3, &start4, &len4, ptr PETSC_F90_2PTR_PARAM(ptrd));
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array4dAccess(F90Array4d *ptr, MPI_Datatype type, void **array PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  if (type == MPIU_SCALAR) {
    f90array4daccessscalar_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_REAL) {
    f90array4daccessreal_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_INT) {
    f90array4daccessint_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else if (type == MPIU_FORTRANADDR) {
    f90array4daccessfortranaddr_(ptr, array PETSC_F90_2PTR_PARAM(ptrd));
  } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  PetscFunctionReturn(PETSC_SUCCESS);
}

PetscErrorCode F90Array4dDestroy(F90Array4d *ptr, MPI_Datatype type PETSC_F90_2PTR_PROTO(ptrd))
{
  PetscFunctionBegin;
  PetscCheck(type == MPIU_SCALAR, PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported MPI_Datatype");
  f90array4ddestroyscalar_(ptr PETSC_F90_2PTR_PARAM(ptrd));
  PetscFunctionReturn(PETSC_SUCCESS);
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array1dgetaddrscalar_      F90ARRAY1DGETADDRSCALAR
  #define f90array1dgetaddrreal_        F90ARRAY1DGETADDRREAL
  #define f90array1dgetaddrint_         F90ARRAY1DGETADDRINT
  #define f90array1dgetaddrmpiint_      F90ARRAY1DGETADDRMPIINT
  #define f90array1dgetaddrfortranaddr_ F90ARRAY1DGETADDRFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array1dgetaddrscalar_      f90array1dgetaddrscalar
  #define f90array1dgetaddrreal_        f90array1dgetaddrreal
  #define f90array1dgetaddrint_         f90array1dgetaddrint
  #define f90array1dgetaddrmpiint_      f90array1dgetaddrmpiint
  #define f90array1dgetaddrfortranaddr_ f90array1dgetaddrfortranaddr
#endif

PETSC_EXTERN void f90array1dgetaddrscalar_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array1dgetaddrreal_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array1dgetaddrint_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array1dgetaddrmpiint_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array1dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array2dgetaddrscalar_      F90ARRAY2DGETADDRSCALAR
  #define f90array2dgetaddrreal_        F90ARRAY2DGETADDRREAL
  #define f90array2dgetaddrint_         F90ARRAY2DGETADDRINT
  #define f90array2dgetaddrfortranaddr_ F90ARRAY2DGETADDRFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array2dgetaddrscalar_      f90array2dgetaddrscalar
  #define f90array2dgetaddrreal_        f90array2dgetaddrreal
  #define f90array2dgetaddrint_         f90array2dgetaddrint
  #define f90array2dgetaddrfortranaddr_ f90array2dgetaddrfortranaddr
#endif

PETSC_EXTERN void f90array2dgetaddrscalar_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array2dgetaddrreal_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array2dgetaddrint_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array2dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array3dgetaddrscalar_      F90ARRAY3DGETADDRSCALAR
  #define f90array3dgetaddrreal_        F90ARRAY3DGETADDRREAL
  #define f90array3dgetaddrint_         F90ARRAY3DGETADDRINT
  #define f90array3dgetaddrfortranaddr_ F90ARRAY3DGETADDRFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array3dgetaddrscalar_      f90array3dgetaddrscalar
  #define f90array3dgetaddrreal_        f90array3dgetaddrreal
  #define f90array3dgetaddrint_         f90array3dgetaddrint
  #define f90array3dgetaddrfortranaddr_ f90array3dgetaddrfortranaddr
#endif

PETSC_EXTERN void f90array3dgetaddrscalar_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array3dgetaddrreal_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array3dgetaddrint_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array3dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}

#if defined(PETSC_HAVE_FORTRAN_CAPS)
  #define f90array4dgetaddrscalar_      F90ARRAY4DGETADDRSCALAR
  #define f90array4dgetaddrreal_        F90ARRAY4DGETADDRREAL
  #define f90array4dgetaddrint_         F90ARRAY4DGETADDRINT
  #define f90array4dgetaddrfortranaddr_ F90ARRAY4DGETADDRFORTRANADDR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  #define f90array4dgetaddrscalar_      f90array4dgetaddrscalar
  #define f90array4dgetaddrreal_        f90array4dgetaddrreal
  #define f90array4dgetaddrint_         f90array4dgetaddrint
  #define f90array4dgetaddrfortranaddr_ f90array4dgetaddrfortranaddr
#endif

PETSC_EXTERN void f90array4dgetaddrscalar_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array4dgetaddrreal_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array4dgetaddrint_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}
PETSC_EXTERN void f90array4dgetaddrfortranaddr_(void *array, PetscFortranAddr *address)
{
  *address = (PetscFortranAddr)array;
}