Actual source code: zdtdsf90.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscds.h>
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
14: PETSC_EXTERN void f90arraysetrealpointer_(const PetscReal *, PetscInt *, PetscInt *, F90Array1d *PETSC_F90_2PTR_PROTO_NOVAR);
16: typedef struct {
17: PetscInt K;
18: PetscInt Nr;
19: PetscInt Np;
20: PetscInt Nb;
21: PetscInt Nc;
22: PetscInt cdim;
23: } PetscTabulationFtn;
25: PETSC_EXTERN void petscdsgettabulationsetsizes_(PetscDS *ds, PetscInt *i, PetscTabulationFtn *tftn, PetscErrorCode *ierr)
26: {
27: PetscTabulation *tab;
29: *ierr = PetscDSGetTabulation(*ds, &tab);
30: if (*ierr) return;
31: *ierr = PetscMemcpy(tftn, tab[*i - 1], sizeof(PetscTabulationFtn));
32: }
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;
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;
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: }