Date: 2025-03-28T21:11:20+00:00

Actual source code: zindexf90.c

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

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define petsclayoutgetrangesf90_ PETSCLAYOUTGETRANGESF90
      6:   #define isgetindicesf90_         ISGETINDICESF90
      7:   #define isrestoreindicesf90_     ISRESTOREINDICESF90
      8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
      9:   #define petsclayoutgetrangesf90_ petsclayoutgetrangesf90
     10:   #define isgetindicesf90_         isgetindicesf90
     11:   #define isrestoreindicesf90_     isrestoreindicesf90
     12: #endif

     14: PETSC_EXTERN void petsclayoutgetrangesf90_(PetscLayout *map, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
     15: {
     16:   const PetscInt *fa;
     17:   PetscInt        len;

     19:   *__ierr = PetscLayoutGetRanges(*map, &fa);
     20:   if (*__ierr) return;
     21:   *__ierr = PetscLayoutGetLocalSize(*map, &len);
     22:   if (*__ierr) return;
     23:   *__ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
     24: }

     26: PETSC_EXTERN void isgetindicesf90_(IS *x, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
     27: {
     28:   const PetscInt *fa;
     29:   PetscInt        len;

     31:   *__ierr = ISGetIndices(*x, &fa);
     32:   if (*__ierr) return;
     33:   *__ierr = ISGetLocalSize(*x, &len);
     34:   if (*__ierr) return;
     35:   *__ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
     36: }
     37: PETSC_EXTERN void isrestoreindicesf90_(IS *x, F90Array1d *ptr, int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
     38: {
     39:   const PetscInt *fa;

     41:   *__ierr = F90Array1dAccess(ptr, MPIU_INT, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
     42:   if (*__ierr) return;
     43:   *__ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
     44:   if (*__ierr) return;
     45:   *__ierr = ISRestoreIndices(*x, &fa);
     46: }