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