Actual source code: zvsectionisf90.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define petscsectiongetconstraintindices_          PETSCSECTIONGETCONSTRAINTINDICES
  6:   #define petscsectionrestoreconstraintindices_      PETSCSECTIONRESTORECONSTRAINTINDICES
  7:   #define petscsectiongetfieldconstraintindices_     PETSCSECTIONGETFIELDCONSTRAINTINDICES
  8:   #define petscsectionrestorefieldconstraintindices_ PETSCSECTIONRESTOREFIELDCONSTRAINTINDICES
  9: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 10:   #define petscsectiongetconstraintindices_          petscsectiongetconstraintindices
 11:   #define petscsectionrestoreconstraintindices_      petscsectionrestoreconstraintindices
 12:   #define petscsectiongetfieldconstraintindices_     petscsectiongetfieldconstraintindices
 13:   #define petscsectionrestorefieldconstraintindices_ petscsectionrestorefieldconstraintindices
 14: #endif

 16: PETSC_EXTERN void petscsectiongetconstraintindices_(PetscSection *s, PetscInt *point, F90Array1d *indices, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 17: {
 18:   const PetscInt *idx;
 19:   PetscInt        n;

 21:   *ierr = PetscSectionGetConstraintIndices(*s, *point, &idx);
 22:   if (*ierr) return;
 23:   *ierr = PetscSectionGetConstraintDof(*s, *point, &n);
 24:   if (*ierr) return;
 25:   *ierr = F90Array1dCreate((void *)idx, MPIU_INT, 1, n, indices PETSC_F90_2PTR_PARAM(ptrd));
 26: }

 28: PETSC_EXTERN void petscsectionrestoreconstraintindices_(PetscSection *s, PetscInt *point, F90Array1d *indices, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 29: {
 30:   *ierr = F90Array1dDestroy(indices, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
 31: }

 33: PETSC_EXTERN void petscsectiongetfieldconstraintindices_(PetscSection *s, PetscInt *point, PetscInt *field, F90Array1d *indices, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 34: {
 35:   const PetscInt *idx;
 36:   PetscInt        n;

 38:   *ierr = PetscSectionGetFieldConstraintIndices(*s, *point, *field, &idx);
 39:   if (*ierr) return;
 40:   *ierr = PetscSectionGetFieldConstraintDof(*s, *point, *field, &n);
 41:   if (*ierr) return;
 42:   *ierr = F90Array1dCreate((void *)idx, MPIU_INT, 1, n, indices PETSC_F90_2PTR_PARAM(ptrd));
 43: }

 45: PETSC_EXTERN void petscsectionrestorefieldconstraintindices_(PetscSection *s, PetscInt *point, PetscInt *field, F90Array1d *indices, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
 46: {
 47:   *ierr = F90Array1dDestroy(indices, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
 48:   if (*ierr) return;
 49: }