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: }