Actual source code: ex1f90.F90

  1: program main
  2: #include <petsc/finclude/petscdmplex.h>
  3:   use petscdmplex
  4:   implicit none
  5: !
  6: !
  7:   DM dm
  8:   PetscInt, dimension(4) :: EC
  9:   PetscInt, pointer :: pEC(:)
 10:   PetscInt, pointer :: pES(:)
 11:   PetscInt c, firstCell, numCells
 12:   PetscInt v, numVertices, numPoints
 13:   PetscInt i0, i4
 14:   PetscErrorCode ierr

 16:   i0 = 0
 17:   i4 = 4

 19:   PetscCallA(PetscInitialize(ierr))

 21:   PetscCallA(DMPlexCreate(PETSC_COMM_WORLD, dm, ierr))
 22:   firstCell = 0
 23:   numCells = 2
 24:   numVertices = 6
 25:   numPoints = numCells + numVertices
 26:   PetscCallA(DMPlexSetChart(dm, i0, numPoints, ierr))
 27:   do c = firstCell, numCells - 1
 28:     PetscCallA(DMPlexSetConeSize(dm, c, i4, ierr))
 29:   end do
 30:   PetscCallA(DMSetUp(dm, ierr))

 32:   EC(1) = 2
 33:   EC(2) = 3
 34:   EC(3) = 4
 35:   EC(4) = 5
 36:   c = 0
 37:   write (*, 1000) 'cell EC 0', c, EC
 38: 1000 format(a, i4, 50i4)
 39:   PetscCallA(DMPlexSetCone(dm, c, EC, ierr))
 40:   PetscCallA(DMPlexGetCone(dm, c, pEC, ierr))
 41:   write (*, 1000) 'cell pEC 0', c, pEC
 42:   PetscCallA(DMPlexRestoreCone(dm, c, pEC, ierr))
 43:   EC(1) = 4
 44:   EC(2) = 5
 45:   EC(3) = 6
 46:   EC(4) = 7
 47:   c = 1
 48:   write (*, 1000) 'cell EC 1', c, EC
 49:   PetscCallA(DMPlexSetCone(dm, c, EC, ierr))
 50:   PetscCallA(DMPlexGetCone(dm, c, pEC, ierr))
 51:   write (*, 1000) 'cell pEC 1', c, pEC
 52:   PetscCallA(DMPlexRestoreCone(dm, c, pEC, ierr))
 53:   CHKMEMQ

 55:   PetscCallA(DMPlexSymmetrize(dm, ierr))
 56:   PetscCallA(DMPlexStratify(dm, ierr))
 57:   PetscCallA(DMPlexGetCone(dm, c, pEC, ierr))
 58:   write (*, 1000) 'cell pEC 3', c, pEC
 59:   PetscCallA(DMPlexRestoreCone(dm, c, pEC, ierr))

 61:   v = 4
 62:   PetscCallA(DMPlexGetSupport(dm, v, pES, ierr))
 63:   write (*, 1000) 'vertex', v, pES
 64:   PetscCallA(DMPlexRestoreSupport(dm, v, pES, ierr))

 66:   PetscCallA(DMDestroy(dm, ierr))
 67:   PetscCallA(PetscFinalize(ierr))
 68: end

 70: ! /*TEST
 71: !
 72: ! test:
 73: !   suffix: 0
 74: !
 75: ! TEST*/