Actual source code: ex1f90.F90

  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

 17:       i0 = 0
 18:       i4 = 4

 20:       PetscCallA(PetscInitialize(ierr))

 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))

 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))

 56:       PetscCallA(DMPlexSymmetrize(dm, ierr))
 57:       PetscCallA(DMPlexStratify(dm, ierr))

 59:       v = 4
 60:       PetscCallA(DMPlexGetSupport(dm, v , pES, ierr))
 61:       write(*,1000) 'vertex',v,pES
 62:       PetscCallA(DMPlexRestoreSupport(dm, v , pES, ierr))

 64:       PetscCallA(DMDestroy(dm,ierr))
 65:       PetscCallA(PetscFinalize(ierr))
 66:       end

 68: ! /*TEST
 69: !
 70: ! test:
 71: !   suffix: 0
 72: !
 73: ! TEST*/