Actual source code: zindexf90.c

  1: #include <petscis.h>
  2: #include <petsc/private/ftnimpl.h>

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define petsclayoutgetranges_     PETSCLAYOUTGETRANGES
  6:   #define petsclayoutrestoreranges_ PETSCLAYOUTRESTORERANGES
  7:   #define isgetindices_             ISGETINDICES
  8:   #define isrestoreindices_         ISRESTOREINDICES
  9: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 10:   #define petsclayoutgetranges_     petsclayoutgetranges
 11:   #define petsclayoutrestoreranges_ petsclayoutrestoreranges
 12:   #define isgetindices_             isgetindices
 13:   #define isrestoreindices_         isrestoreindices
 14: #endif

 16: PETSC_EXTERN void petsclayoutgetranges_(PetscLayout *map, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 17: {
 18:   const PetscInt *fa;
 19:   PetscMPIInt     size;

 21:   *ierr = PetscLayoutGetRanges(*map, &fa);
 22:   if (*ierr) return;
 23:   *ierr = MPI_Comm_size((*map)->comm, &size);
 24:   if (*ierr) return;
 25:   *ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, (PetscInt)size + 1, ptr PETSC_F90_2PTR_PARAM(ptrd));
 26: }

 28: PETSC_EXTERN void petsclayoutrestoreranges_(PetscLayout *map, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 29: {
 30:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
 31: }

 33: PETSC_EXTERN void isgetindices_(IS *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 34: {
 35:   const PetscInt *fa;
 36:   PetscInt        len;

 38:   *ierr = ISGetIndices(*x, &fa);
 39:   if (*ierr) return;
 40:   *ierr = ISGetLocalSize(*x, &len);
 41:   if (*ierr) return;
 42:   *ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
 43: }
 44: PETSC_EXTERN void isrestoreindices_(IS *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 45: {
 46:   const PetscInt *fa;

 48:   *ierr = F90Array1dAccess(ptr, MPIU_INT, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
 49:   if (*ierr) return;
 50:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
 51:   if (*ierr) return;
 52:   *ierr = ISRestoreIndices(*x, &fa);
 53: }