Actual source code: ex1f90.F90

petsc-3.13.4 2020-08-01
Report Typos and Errors
  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:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 21:      if (ierr .ne. 0) then
 22:         print*,'Unable to initialize PETSc'
 23:         stop
 24:       endif
 25:       call DMPlexCreate(PETSC_COMM_WORLD, dm, ierr);CHKERRA(ierr)
 26:       firstCell = 0
 27:       numCells = 2
 28:       numVertices = 6
 29:       numPoints = numCells+numVertices
 30:       call DMPlexSetChart(dm, i0, numPoints, ierr);CHKERRA(ierr)
 31:       do c=firstCell,numCells-1
 32:          call DMPlexSetConeSize(dm, c, i4, ierr);CHKERRA(ierr)
 33:       end do
 34:       call DMSetUp(dm, ierr);CHKERRA(ierr)

 36:       EC(1) = 2
 37:       EC(2) = 3
 38:       EC(3) = 4
 39:       EC(4) = 5
 40:       pEC => EC
 41:       c = 0
 42:       write(*,1000) 'cell',c,pEC
 43:  1000 format (a,i4,50i4)
 44:       call DMPlexSetCone(dm, c , pEC, ierr);CHKERRA(ierr)
 45:       call DMPlexGetCone(dm, c , pEC, ierr);CHKERRA(ierr)
 46:       write(*,1000) 'cell',c,pEC
 47:       EC(1) = 4
 48:       EC(2) = 5
 49:       EC(3) = 6
 50:       EC(4) = 7
 51:       pEC => EC
 52:       c = 1
 53:       write(*,1000) 'cell',c,pEC
 54:       call DMPlexSetCone(dm, c , pEC, ierr);CHKERRA(ierr)
 55:       call DMPlexGetCone(dm, c , pEC, ierr);CHKERRA(ierr)
 56:       write(*,1000) 'cell',c,pEC
 57:       call DMPlexRestoreCone(dm, c , pEC, ierr);CHKERRA(ierr)

 59:       call DMPlexSymmetrize(dm, ierr);CHKERRA(ierr)
 60:       call DMPlexStratify(dm, ierr);CHKERRA(ierr)

 62:       v = 4
 63:       call DMPlexGetSupport(dm, v , pES, ierr);CHKERRA(ierr)
 64:       write(*,1000) 'vertex',v,pES
 65:       call DMPlexRestoreSupport(dm, v , pES, ierr);CHKERRA(ierr)

 67:       call DMDestroy(dm,ierr);CHKERRA(ierr)
 68:       call PetscFinalize(ierr)
 69:       end

 71: ! /*TEST
 72: !
 73: ! test:
 74: !   suffix: 0
 75: !
 76: ! TEST*/