Actual source code: ex1f90.F90
petsc-3.12.2 2019-11-22
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: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
21: if (ierr .ne. 0) then
22: print*,'Unable to initialize PETSc'
23: stop
24: endif
25: call DMPlexCreate(PETSC_COMM_WORLD, dm, ierr);CHKERRA(ierr)
26: firstCell = 0
27: numCells = 2
28: numVertices = 6
29: numPoints = numCells+numVertices
30: call DMPlexSetChart(dm, i0, numPoints, ierr);CHKERRA(ierr)
31: do c=firstCell,numCells-1
32: call DMPlexSetConeSize(dm, c, i4, ierr);CHKERRA(ierr)
33: end do
34: call DMSetUp(dm, ierr);CHKERRA(ierr)
36: EC(1) = 2
37: EC(2) = 3
38: EC(3) = 4
39: EC(4) = 5
40: pEC => EC
41: c = 0
42: write(*,*) 'cell',c,pEC
43: call DMPlexSetCone(dm, c , pEC, ierr);CHKERRA(ierr)
44: call DMPlexGetCone(dm, c , pEC, ierr);CHKERRA(ierr)
45: write(*,*) 'cell',c,pEC
46: EC(1) = 4
47: EC(2) = 5
48: EC(3) = 6
49: EC(4) = 7
50: pEC => EC
51: c = 1
52: write(*,*) 'cell',c,pEC
53: call DMPlexSetCone(dm, c , pEC, ierr);CHKERRA(ierr)
54: call DMPlexGetCone(dm, c , pEC, ierr);CHKERRA(ierr)
55: write(*,*) 'cell',c,pEC
56: call DMPlexRestoreCone(dm, c , pEC, ierr);CHKERRA(ierr)
58: call DMPlexSymmetrize(dm, ierr);CHKERRA(ierr)
59: call DMPlexStratify(dm, ierr);CHKERRA(ierr)
61: v = 4
62: call DMPlexGetSupport(dm, v , pES, ierr);CHKERRA(ierr)
63: write(*,*) 'vertex',v,pES
64: call DMPlexRestoreSupport(dm, v , pES, ierr);CHKERRA(ierr)
66: call DMDestroy(dm,ierr);CHKERRA(ierr)
67: call PetscFinalize(ierr)
68: end
70: ! /*TEST
71: !
72: ! test:
73: ! suffix: 0
74: !
75: ! TEST*/