xref: /petsc/src/vec/is/section/interface/ftn-custom/zvsectionisf90.c (revision 0baf8eba40dbc839082666f9f7396a225d6f663c)
1 #include <petscsection.h>
2 #include <petsc/private/ftnimpl.h>
3 
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
15 
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;
20 
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 }
27 
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 }
32 
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;
37 
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 }
44 
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 }
50