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