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:   #define isdestroy_               ISDESTROY
  9: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 10:   #define petsclayoutgetrangesf90_ petsclayoutgetrangesf90
 11:   #define isgetindicesf90_         isgetindicesf90
 12:   #define isrestoreindicesf90_     isrestoreindicesf90
 13:   #define isdestroy_               isdestroy
 14: #endif

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

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

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

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

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

 50: PETSC_EXTERN void isdestroy_(IS *x, int *ierr)
 51: {
 52:   PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(x);
 53:   *ierr = ISDestroy(x);
 54:   if (*ierr) return;
 55:   PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(x);
 56: }