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 16 17 i0 = 0 18 i4 = 4 19 20 PetscCallA(PetscInitialize(ierr)) 21 22 PetscCallA(DMPlexCreate(PETSC_COMM_WORLD, dm, ierr)) 23 firstCell = 0 24 numCells = 2 25 numVertices = 6 26 numPoints = numCells+numVertices 27 PetscCallA(DMPlexSetChart(dm, i0, numPoints, ierr)) 28 do c=firstCell,numCells-1 29 PetscCallA(DMPlexSetConeSize(dm, c, i4, ierr)) 30 end do 31 PetscCallA(DMSetUp(dm, ierr)) 32 33 EC(1) = 2 34 EC(2) = 3 35 EC(3) = 4 36 EC(4) = 5 37 pEC => EC 38 c = 0 39 write(*,1000) 'cell',c,pEC 40 1000 format (a,i4,50i4) 41 PetscCallA(DMPlexSetCone(dm, c , pEC, ierr)) 42 PetscCallA(DMPlexGetCone(dm, c , pEC, ierr)) 43 write(*,1000) 'cell',c,pEC 44 EC(1) = 4 45 EC(2) = 5 46 EC(3) = 6 47 EC(4) = 7 48 pEC => EC 49 c = 1 50 write(*,1000) 'cell',c,pEC 51 PetscCallA(DMPlexSetCone(dm, c , pEC, ierr)) 52 PetscCallA(DMPlexGetCone(dm, c , pEC, ierr)) 53 write(*,1000) 'cell',c,pEC 54 PetscCallA(DMPlexRestoreCone(dm, c , pEC, ierr)) 55 56 PetscCallA(DMPlexSymmetrize(dm, ierr)) 57 PetscCallA(DMPlexStratify(dm, ierr)) 58 59 v = 4 60 PetscCallA(DMPlexGetSupport(dm, v , pES, ierr)) 61 write(*,1000) 'vertex',v,pES 62 PetscCallA(DMPlexRestoreSupport(dm, v , pES, ierr)) 63 64 PetscCallA(DMDestroy(dm,ierr)) 65 PetscCallA(PetscFinalize(ierr)) 66 end 67 68! /*TEST 69! 70! test: 71! suffix: 0 72! 73! TEST*/ 74