Actual source code: ex2f90.F90
petsc-3.9.3 2018-07-02
1: program main
2: #include <petsc/finclude/petscdmplex.h>
3: use petscdmplex
4: implicit none
6: DM dm
7: PetscInt, target, dimension(3) :: EC
8: PetscInt, target, dimension(2) :: VE
9: PetscInt, pointer :: pEC(:), pVE(:)
10: PetscInt, pointer :: nClosure(:)
11: PetscInt, pointer :: nJoin(:)
12: PetscInt, pointer :: nMeet(:)
13: PetscInt dim, cell, size
14: PetscInt i0,i1,i2,i3,i4,i5,i6,i7
15: PetscInt i8,i9,i10,i11
16: PetscErrorCode ierr
18: i0 = 0
19: i1 = 1
20: i2 = 2
21: i3 = 3
22: i4 = 4
23: i5 = 5
24: i6 = 6
25: i7 = 7
26: i8 = 8
27: i9 = 9
28: i10 = 10
29: i11 = 11
31: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
32: if (ierr .ne. 0) then
33: print*,'Unable to initialize PETSc'
34: stop
35: endif
37: call DMPlexCreate(PETSC_COMM_WORLD, dm, ierr);CHKERRA(ierr)
38: call PetscObjectSetName(dm, 'Mesh', ierr);CHKERRA(ierr)
39: dim = 2
40: call DMSetDimension(dm, dim, ierr);CHKERRA(ierr)
42: ! Make Doublet Mesh from Fig 2 of Flexible Representation of Computational Meshes,
43: ! except indexing is from 0 instead of 1 and we obey the new restrictions on
44: ! numbering: cells, vertices, faces, edges
45: call DMPlexSetChart(dm, i0, i11, ierr);CHKERRA(ierr)
46: ! cells
47: call DMPlexSetConeSize(dm, i0, i3, ierr);CHKERRA(ierr)
48: call DMPlexSetConeSize(dm, i1, i3, ierr);CHKERRA(ierr)
49: ! edges
50: call DMPlexSetConeSize(dm, i6, i2, ierr);CHKERRA(ierr)
51: call DMPlexSetConeSize(dm, i7, i2, ierr);CHKERRA(ierr)
52: call DMPlexSetConeSize(dm, i8, i2, ierr);CHKERRA(ierr)
53: call DMPlexSetConeSize(dm, i9, i2, ierr);CHKERRA(ierr)
54: call DMPlexSetConeSize(dm, i10, i2, ierr);CHKERRA(ierr)
56: call DMSetUp(dm, ierr);CHKERRA(ierr)
58: EC(1) = 6
59: EC(2) = 7
60: EC(3) = 8
61: pEC => EC
62: call DMPlexSetCone(dm, i0, pEC, ierr);CHKERRA(ierr)
63: EC(1) = 7
64: EC(2) = 9
65: EC(3) = 10
66: pEC => EC
67: call DMPlexSetCone(dm, i1 , pEC, ierr);CHKERRA(ierr)
69: VE(1) = 2
70: VE(2) = 3
71: pVE => VE
72: call DMPlexSetCone(dm, i6 , pVE, ierr);CHKERRA(ierr)
73: VE(1) = 3
74: VE(2) = 4
75: pVE => VE
76: call DMPlexSetCone(dm, i7 , pVE, ierr);CHKERRA(ierr)
77: VE(1) = 4
78: VE(2) = 2
79: pVE => VE
80: call DMPlexSetCone(dm, i8 , pVE, ierr);CHKERRA(ierr)
81: VE(1) = 3
82: VE(2) = 5
83: pVE => VE
84: call DMPlexSetCone(dm, i9 , pVE, ierr);CHKERRA(ierr)
85: VE(1) = 5
86: VE(2) = 4
87: pVE => VE
88: call DMPlexSetCone(dm, i10 , pVE, ierr);CHKERRA(ierr)
90: call DMPlexSymmetrize(dm,ierr);CHKERRA(ierr)
91: call DMPlexStratify(dm,ierr);CHKERRA(ierr)
92: call DMView(dm, PETSC_VIEWER_STDOUT_WORLD, ierr);CHKERRA(ierr)
94: ! Test Closure
95: do cell = 0,1
96: call DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,nClosure,ierr);CHKERRA(ierr)
97: ! Different Fortran compilers print a different number of columns
98: ! per row producing different outputs in the test runs hence
99: ! do not print the nClosure
100: ! write(*,*) nClosure
101: call DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,nClosure,ierr);CHKERRA(ierr)
102: end do
104: ! Test Join
105: size = 2
106: VE(1) = 6
107: VE(2) = 7
108: pVE => VE
109: call DMPlexGetJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
110: write(*,*) 'Join of',pVE,'is',nJoin
111: call DMPlexRestoreJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
112: size = 2
113: VE(1) = 9
114: VE(2) = 7
115: pVE => VE
116: call DMPlexGetJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
117: write(*,*) 'Join of',pVE,'is',nJoin
118: call DMPlexRestoreJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
119: ! Test Full Join
120: size = 3
121: EC(1) = 3
122: EC(2) = 4
123: EC(3) = 5
124: pEC => EC
125: call DMPlexGetFullJoin(dm, size, pEC, nJoin, ierr);CHKERRA(ierr)
126: write(*,*) 'Full Join of',pEC,'is',nJoin
127: call DMPlexRestoreJoin(dm, size, pEC, nJoin, ierr);CHKERRA(ierr)
128: ! Test Meet
129: size = 2
130: VE(1) = 0
131: VE(2) = 1
132: pVE => VE
133: call DMPlexGetMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
134: write(*,*) 'Meet of',pVE,'is',nMeet
135: call DMPlexRestoreMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
136: size = 2
137: VE(1) = 6
138: VE(2) = 7
139: pVE => VE
140: call DMPlexGetMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
141: write(*,*) 'Meet of',pVE,'is',nMeet
142: call DMPlexRestoreMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
144: call DMDestroy(dm, ierr);CHKERRA(ierr)
145: call PetscFinalize(ierr)
146: end
147: !
148: !/*TEST
149: !
150: ! test:
151: ! suffix: 0
152: !
153: !TEST*/