1*6dd63270SBarry Smith #include <petsc/private/ftnimpl.h>
2*6dd63270SBarry Smith #include <petscds.h>
3*6dd63270SBarry Smith
4*6dd63270SBarry Smith #if defined(PETSC_HAVE_FORTRAN_CAPS)
5*6dd63270SBarry Smith #define petscdsgettabulationsetsizes_ PETSCDSGETTABULATIONSETSIZES
6*6dd63270SBarry Smith #define petscdsgettabulationsetpointers_ PETSCDSGETTABULATIONSETPOINTERS
7*6dd63270SBarry Smith #define f90arraysetrealpointer_ F90ARRAYSETREALPOINTER
8*6dd63270SBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9*6dd63270SBarry Smith #define petscdsgettabulationsetsizes_ petscdsgettabulationsetsizes
10*6dd63270SBarry Smith #define petscdsgettabulationsetpointers_ petscdsgettabulationsetpointers
11*6dd63270SBarry Smith #define f90arraysetrealpointer_ f90arraysetrealpointer
12*6dd63270SBarry Smith #endif
13*6dd63270SBarry Smith
14*6dd63270SBarry Smith PETSC_EXTERN void f90arraysetrealpointer_(const PetscReal *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
15*6dd63270SBarry Smith
16*6dd63270SBarry Smith typedef struct {
17*6dd63270SBarry Smith PetscInt K;
18*6dd63270SBarry Smith PetscInt Nr;
19*6dd63270SBarry Smith PetscInt Np;
20*6dd63270SBarry Smith PetscInt Nb;
21*6dd63270SBarry Smith PetscInt Nc;
22*6dd63270SBarry Smith PetscInt cdim;
23*6dd63270SBarry Smith } PetscTabulationFtn;
24*6dd63270SBarry Smith
petscdsgettabulationsetsizes_(PetscDS * ds,PetscInt * i,PetscTabulationFtn * tftn,PetscErrorCode * ierr)25*6dd63270SBarry Smith PETSC_EXTERN void petscdsgettabulationsetsizes_(PetscDS *ds, PetscInt *i, PetscTabulationFtn *tftn, PetscErrorCode *ierr)
26*6dd63270SBarry Smith {
27*6dd63270SBarry Smith PetscTabulation *tab;
28*6dd63270SBarry Smith
29*6dd63270SBarry Smith *ierr = PetscDSGetTabulation(*ds, &tab);
30*6dd63270SBarry Smith if (*ierr) return;
31*6dd63270SBarry Smith *ierr = PetscMemcpy(tftn, tab[*i - 1], sizeof(PetscTabulationFtn));
32*6dd63270SBarry Smith }
33*6dd63270SBarry Smith
petscdsgettabulationsetpointers_(PetscDS * ds,PetscInt * i,F90Array1d * ptrB,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrb))34*6dd63270SBarry Smith PETSC_EXTERN void petscdsgettabulationsetpointers_(PetscDS *ds, PetscInt *i, F90Array1d *ptrB, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrb))
35*6dd63270SBarry Smith {
36*6dd63270SBarry Smith PetscTabulation *tab;
37*6dd63270SBarry Smith PetscInt size;
38*6dd63270SBarry Smith
39*6dd63270SBarry Smith *ierr = PetscDSGetTabulation(*ds, &tab);
40*6dd63270SBarry Smith if (*ierr) return;
41*6dd63270SBarry Smith size = tab[*i - 1]->Nr * tab[*i - 1]->Np * tab[*i - 1]->Nb * tab[*i - 1]->Nc;
42*6dd63270SBarry Smith
43*6dd63270SBarry Smith for (PetscInt j = 0; j <= tab[*i - 1]->K; j++) {
44*6dd63270SBarry Smith f90arraysetrealpointer_(tab[*i - 1]->T[j], &size, &j, ptrB PETSC_F90_2PTR_PARAM(ptrb));
45*6dd63270SBarry Smith if (*ierr) return;
46*6dd63270SBarry Smith size *= tab[*i - 1]->cdim;
47*6dd63270SBarry Smith }
48*6dd63270SBarry Smith }
49