Actual source code: ex4f90.F90

  1: ! setting up DMPlex for finite elements
  2: ! Contributed by Pratheek Shanthraj <p.shanthraj@mpie.de>
  3: #include <petsc/finclude/petsc.h>
  4: program main
  5:   use petsc
  6:   implicit none
  7:   DM :: dm
  8:   PetscDS :: ds
  9:   PetscInt, parameter :: dim = 3
 10:   PetscBool, parameter :: simplex = PETSC_TRUE, interpolate = PETSC_TRUE
 11:   PetscReal, parameter :: refinementLimit = 0.0
 12:   PetscErrorCode :: ierr
 13:   PetscTabulation, pointer :: tab(:)
 14:   PetscFE fe, rfe
 15:   PetscObject obj

 17:   PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))
 18:   PetscCallA(DMPlexCreateDoublet(PETSC_COMM_WORLD, dim, simplex, interpolate, refinementLimit, dm, ierr))
 19:   PetscCallA(PetscFECreateDefault(PETSC_COMM_WORLD, dim, 1_PETSC_INT_KIND, simplex, 'name', -1_PETSC_INT_KIND, fe, ierr))
 20:   PetscCallA(PetscObjectSetName(fe, 'name', ierr))
 21:   PetscCallA(DMSetField(dm, 0_PETSC_INT_KIND, PETSC_NULL_DMLABEL, PetscObjectCast(fe), ierr))
 22:   PetscCallA(DMSetField(dm, 1_PETSC_INT_KIND, PETSC_NULL_DMLABEL, PetscObjectCast(fe), ierr))

 24:   PetscCallA(DMSetUp(dm, ierr))
 25:   PetscCallA(DMCreateDS(dm, ierr))
 26:   PetscCallA(DMGetDS(dm, ds, ierr))
 27:   PetscCallA(PetscDSGetTabulation(ds, tab, ierr))
 28:   print *, tab(1)%ptr%T(1)%ptr
 29:   print *, tab(1)%ptr%T(2)%ptr
 30:   print *, tab(2)%ptr%T(1)%ptr
 31:   print *, tab(2)%ptr%T(2)%ptr
 32:   PetscCallA(PetscDSRestoreTabulation(ds, tab, ierr))

 34:   PetscCallA(PetscDSGetDiscretization(ds, 0_PETSC_INT_KIND, obj, ierr))
 35:   PetscObjectSpecificCast(rfe, obj)
 36:   PetscCallA(PetscFEDestroy(fe, ierr))
 37:   PetscCallA(DMDestroy(dm, ierr))
 38:   PetscCallA(PetscFinalize(ierr))
 39: end program main
 40: !/*TEST
 41: !
 42: !  test:
 43: !    nsize: 1
 44: !
 45: !TEST*/