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