Actual source code: zdtf90.c

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

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define petscquadraturegetdata_     PETSCQUADRATUREGETDATA
      6:   #define petscquadraturerestoredata_ PETSCQUADRATURERESTOREDATA
      7:   #define petscquadraturesetdata_     PETSCQUADRATURESETDATA
      8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
      9:   #define petscquadraturegetdata_     petscquadraturegetdata
     10:   #define petscquadraturerestoredata_ petscquadraturerestoredata
     11:   #define petscquadraturesetdata_     petscquadraturesetdata
     12: #endif

     14: PETSC_EXTERN void petscquadraturegetdata_(PetscQuadrature *q, PetscInt *dim, PetscInt *Nc, PetscInt *npoints, F90Array1d *ptrP, F90Array1d *ptrW, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrp) PETSC_F90_2PTR_PROTO(ptrw))
     15: {
     16:   const PetscReal *points, *weights;

     18:   *ierr = PetscQuadratureGetData(*q, dim, Nc, npoints, &points, &weights);
     19:   if (*ierr) return;
     20:   *ierr = F90Array1dCreate((void *)points, MPIU_REAL, 1, (*npoints) * (*dim), ptrP PETSC_F90_2PTR_PARAM(ptrp));
     21:   if (*ierr) return;
     22:   *ierr = F90Array1dCreate((void *)weights, MPIU_REAL, 1, (*npoints) * (*Nc), ptrW PETSC_F90_2PTR_PARAM(ptrw));
     23: }

     25: PETSC_EXTERN void petscquadraturerestoredata_(PetscQuadrature *q, PetscInt *dim, PetscInt *Nc, PetscInt *npoints, F90Array1d *ptrP, F90Array1d *ptrW, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrp) PETSC_F90_2PTR_PROTO(ptrw))
     26: {
     27:   *ierr = F90Array1dDestroy(ptrP, MPIU_REAL PETSC_F90_2PTR_PARAM(ptrp));
     28:   if (*ierr) return;
     29:   *ierr = F90Array1dDestroy(ptrW, MPIU_REAL PETSC_F90_2PTR_PARAM(ptrw));
     30: }

     32: PETSC_EXTERN void petscquadraturesetdata_(PetscQuadrature *q, PetscInt *dim, PetscInt *Nc, PetscInt *npoints, F90Array1d *ptrP, F90Array1d *ptrW, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrp) PETSC_F90_2PTR_PROTO(ptrw))
     33: {
     34:   PetscReal *points, *weights;

     36:   *ierr = F90Array1dAccess(ptrP, MPIU_REAL, (void **)&points PETSC_F90_2PTR_PARAM(ptrp));
     37:   if (*ierr) return;
     38:   *ierr = F90Array1dAccess(ptrW, MPIU_REAL, (void **)&weights PETSC_F90_2PTR_PARAM(ptrw));
     39:   if (*ierr) return;
     40:   *ierr = PetscQuadratureSetData(*q, *dim, *Nc, *npoints, points, weights);
     41: }