xref: /petsc/src/dm/impls/plex/tests/ex1f90.F90 (revision ce78bad369055609e946c9d2c25ea67a45873e27)
1c4762a1bSJed Brown      program main
2c4762a1bSJed Brown#include <petsc/finclude/petscdmplex.h>
3c4762a1bSJed Brown      use petscdmplex
4c4762a1bSJed Brown      implicit none
5c4762a1bSJed Brown!
6c4762a1bSJed Brown!
7c4762a1bSJed Brown      DM dm
8*ce78bad3SBarry 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
37*ce78bad3SBarry Smith      write(*,1000) 'cell EC 0',c,EC
38c4762a1bSJed Brown 1000 format (a,i4,50i4)
39*ce78bad3SBarry Smith      PetscCallA(DMPlexSetCone(dm, c , EC, ierr))
40d8606c27SBarry Smith      PetscCallA(DMPlexGetCone(dm, c , pEC, ierr))
41*ce78bad3SBarry Smith      write(*,1000) 'cell pEC 0',c,pEC
42*ce78bad3SBarry 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
48*ce78bad3SBarry Smith      write(*,1000) 'cell EC 1',c,EC
49*ce78bad3SBarry Smith      PetscCallA(DMPlexSetCone(dm, c , EC, ierr))
50d8606c27SBarry Smith      PetscCallA(DMPlexGetCone(dm, c , pEC, ierr))
51*ce78bad3SBarry Smith      write(*,1000) 'cell pEC 1',c,pEC
52d8606c27SBarry Smith      PetscCallA(DMPlexRestoreCone(dm, c, pEC, ierr))
53*ce78bad3SBarry Smith      CHKMEMQ
54c4762a1bSJed Brown
55d8606c27SBarry Smith      PetscCallA(DMPlexSymmetrize(dm, ierr))
56d8606c27SBarry Smith      PetscCallA(DMPlexStratify(dm, ierr))
57*ce78bad3SBarry Smith      PetscCallA(DMPlexGetCone(dm, c , pEC, ierr))
58*ce78bad3SBarry Smith      write(*,1000) 'cell pEC 3',c,pEC
59*ce78bad3SBarry 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 Brown      end
69c4762a1bSJed Brown
70c4762a1bSJed Brown! /*TEST
71c4762a1bSJed Brown!
72c4762a1bSJed Brown! test:
73c4762a1bSJed Brown!   suffix: 0
74c4762a1bSJed Brown!
75c4762a1bSJed Brown! TEST*/
76