Actual source code: ex1f90.F90
1: program main
2: #include <petsc/finclude/petscdmplex.h>
3: use petscdmplex
4: use petscsys
5: implicit none
6: !
7: !
8: DM dm
9: PetscInt, target, dimension(4) :: EC
10: PetscInt, pointer :: pEC(:)
11: PetscInt, pointer :: pES(:)
12: PetscInt c, firstCell, numCells
13: PetscInt v, numVertices, numPoints
14: PetscInt i0,i4
15: PetscErrorCode ierr
17: i0 = 0
18: i4 = 4
20: PetscCallA(PetscInitialize(ierr))
22: PetscCallA(DMPlexCreate(PETSC_COMM_WORLD, dm, ierr))
23: firstCell = 0
24: numCells = 2
25: numVertices = 6
26: numPoints = numCells+numVertices
27: PetscCallA(DMPlexSetChart(dm, i0, numPoints, ierr))
28: do c=firstCell,numCells-1
29: PetscCallA(DMPlexSetConeSize(dm, c, i4, ierr))
30: end do
31: PetscCallA(DMSetUp(dm, ierr))
33: EC(1) = 2
34: EC(2) = 3
35: EC(3) = 4
36: EC(4) = 5
37: pEC => EC
38: c = 0
39: write(*,1000) 'cell',c,pEC
40: 1000 format (a,i4,50i4)
41: PetscCallA(DMPlexSetCone(dm, c , pEC, ierr))
42: PetscCallA(DMPlexGetCone(dm, c , pEC, ierr))
43: write(*,1000) 'cell',c,pEC
44: EC(1) = 4
45: EC(2) = 5
46: EC(3) = 6
47: EC(4) = 7
48: pEC => EC
49: c = 1
50: write(*,1000) 'cell',c,pEC
51: PetscCallA(DMPlexSetCone(dm, c , pEC, ierr))
52: PetscCallA(DMPlexGetCone(dm, c , pEC, ierr))
53: write(*,1000) 'cell',c,pEC
54: PetscCallA(DMPlexRestoreCone(dm, c , pEC, ierr))
56: PetscCallA(DMPlexSymmetrize(dm, ierr))
57: PetscCallA(DMPlexStratify(dm, ierr))
59: v = 4
60: PetscCallA(DMPlexGetSupport(dm, v , pES, ierr))
61: write(*,1000) 'vertex',v,pES
62: PetscCallA(DMPlexRestoreSupport(dm, v , pES, ierr))
64: PetscCallA(DMDestroy(dm,ierr))
65: PetscCallA(PetscFinalize(ierr))
66: end
68: ! /*TEST
69: !
70: ! test:
71: ! suffix: 0
72: !
73: ! TEST*/