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