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