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*/