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