Actual source code: zswarmf90.c

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

  4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  5:   #define dmswarmgetfield_     DMSWARMGETFIELD
  6:   #define dmswarmrestorefield_ DMSWARMRESTOREFIELD
  7: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
  8:   #define dmswarmgetfield_     dmswarmgetfield
  9:   #define dmswarmrestorefield_ dmswarmrestorefield
 10: #endif

 12: /* Definitions of Fortran Wrapper routines */

 14: PETSC_EXTERN void dmswarmgetfield_(DM *dm, char *name, PetscInt *blocksize, PetscDataType *type, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd), PETSC_FORTRAN_CHARLEN_T lenN)
 15: {
 16:   PetscScalar *v;
 17:   PetscInt     n;
 18:   char        *fieldname;

 20:   FIXCHAR(name, lenN, fieldname);
 21:   *ierr = DMSwarmGetSize(*dm, &n);
 22:   if (*ierr) return;
 23:   *ierr = DMSwarmGetField(*dm, fieldname, blocksize, type, (void **)&v);
 24:   if (*ierr) return;
 25:   *ierr = F90Array1dCreate((void *)v, MPIU_SCALAR, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
 26:   FREECHAR(name, fieldname);
 27: }

 29: PETSC_EXTERN void dmswarmrestorefield_(DM *dm, char *name, PetscInt *blocksize, PetscDataType *type, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd), PETSC_FORTRAN_CHARLEN_T lenN)
 30: {
 31:   PetscScalar *v;
 32:   char        *fieldname;

 34:   FIXCHAR(name, lenN, fieldname);
 35:   *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&v PETSC_F90_2PTR_PARAM(ptrd));
 36:   if (*ierr) return;
 37:   if (*ierr) return;
 38:   *ierr = DMSwarmRestoreField(*dm, fieldname, blocksize, type, (void **)&v);
 39:   if (*ierr) return;
 40:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
 41:   FREECHAR(name, fieldname);
 42: }