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

  4: #if PetscDefined(HAVE_FORTRAN_CAPS)
  5:   #define petscquadraturegetdata_     PETSCQUADRATUREGETDATA
  6:   #define petscquadraturerestoredata_ PETSCQUADRATURERESTOREDATA
  7:   #define petscquadraturesetdata_     PETSCQUADRATURESETDATA
  8: #elif !PetscDefined(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;
 17:   PetscInt         dim_, Nc_, npoints_;

 19:   CHKFORTRANNULLINTEGER(dim);
 20:   CHKFORTRANNULLINTEGER(Nc);
 21:   CHKFORTRANNULLINTEGER(npoints);
 22:   *ierr = PetscQuadratureGetData(*q, &dim_, &Nc_, &npoints_, &points, &weights);
 23:   if (*ierr) return;
 24:   if (dim) *dim = dim_;
 25:   if (Nc) *Nc = Nc_;
 26:   if (npoints) *npoints = npoints_;
 27:   if (!FORTRANNULLREALPOINTER(ptrP)) {
 28:     *ierr = F90Array1dCreate((void *)points, MPIU_REAL, 1, npoints_ * dim_, ptrP PETSC_F90_2PTR_PARAM(ptrp));
 29:     if (*ierr) return;
 30:   }
 31:   if (!FORTRANNULLREALPOINTER(ptrW)) {
 32:     *ierr = F90Array1dCreate((void *)weights, MPIU_REAL, 1, npoints_ * Nc_, ptrW PETSC_F90_2PTR_PARAM(ptrw));
 33:     if (*ierr) return;
 34:   }
 35:   *ierr = PETSC_SUCCESS;
 36: }

 38: 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))
 39: {
 40:   if (!FORTRANNULLREALPOINTER(ptrP)) {
 41:     *ierr = F90Array1dDestroy(ptrP, MPIU_REAL PETSC_F90_2PTR_PARAM(ptrp));
 42:     if (*ierr) return;
 43:   }
 44:   if (!FORTRANNULLREALPOINTER(ptrW)) {
 45:     *ierr = F90Array1dDestroy(ptrW, MPIU_REAL PETSC_F90_2PTR_PARAM(ptrw));
 46:     if (*ierr) return;
 47:   }
 48:   *ierr = PETSC_SUCCESS;
 49: }

 51: 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))
 52: {
 53:   PetscReal *points, *weights;

 55:   *ierr = F90Array1dAccess(ptrP, MPIU_REAL, (void **)&points PETSC_F90_2PTR_PARAM(ptrp));
 56:   if (*ierr) return;
 57:   *ierr = F90Array1dAccess(ptrW, MPIU_REAL, (void **)&weights PETSC_F90_2PTR_PARAM(ptrw));
 58:   if (*ierr) return;
 59:   *ierr = PetscQuadratureSetData(*q, *dim, *Nc, *npoints, points, weights);
 60: }