1: program  ex1f90
  2: #include <petsc/finclude/petscdmlabel.h>
  3:   use petscdm
  4:   use petscdmlabel
  5:   implicit NONE

  7:   type(tDM)                         :: dm, dmDist
  8:   character(len=PETSC_MAX_PATH_LEN) :: filename
  9:   PetscBool                         :: interpolate = PETSC_FALSE
 10:   PetscBool                         :: flg
 11:   PetscErrorCode                    :: ierr
 12:   PetscInt                          :: izero
 13:   izero = 0

 15:   call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 16:     if (ierr .ne. 0) then
 17:     print*,'Unable to initialize PETSc'
 18:     stop
 19:   endif
 20:   call PetscOptionsGetString(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-i",filename,flg,ierr);CHKERRA(ierr)
 21:   call PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-interpolate",interpolate,flg,ierr);CHKERRA(ierr)

 23:   call DMPlexCreateFromFile(PETSC_COMM_WORLD,filename,interpolate,dm,ierr);CHKERRA(ierr)
 24:   call DMPlexDistribute(dm,izero,PETSC_NULL_SF,dmDist,ierr);CHKERRA(ierr)
 25:   if (dmDist /= PETSC_NULL_DM) then
 26:     call DMDestroy(dm,ierr);CHKERRA(ierr)
 27:     dm = dmDist
 28:   end if

 30:   call ViewLabels(dm,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
 31:   call DMDestroy(dm,ierr);CHKERRA(ierr)
 32:   call PetscFinalize(ierr)

 34: contains
 35:   subroutine ViewLabels(dm,viewer,ierr)
 36:     type(tDM)                        :: dm
 37:     type(tPetscViewer)               :: viewer
 38:     PetscErrorCode                   :: ierr

 40:     DMLabel                          :: label
 41:     type(tIS)                        :: labelIS
 42:     character(len=PETSC_MAX_PATH_LEN):: labelName,IObuffer
 43:     PetscInt                         :: numLabels,l

 45:     call DMGetNumLabels(dm, numLabels, ierr);
 46:     write(IObuffer,*) 'Number of labels: ', numLabels, '\n'
 47:     call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr)
 48:     do l = 0, numLabels-1
 49:       call DMGetLabelName(dm, l, labelName, ierr);CHKERRQ(ierr)
 50:       write(IObuffer,*) 'label ',l,' name: ',trim(labelName),'\n'
 51:       call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr)

 53:       call PetscViewerASCIIPrintf(viewer, "IS of values\n", ierr);CHKERRQ(ierr)
 54:       call DMGetLabel(dm, labelName, label, ierr);CHKERRQ(ierr)
 55:       call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr)
 56: !      call PetscViewerASCIIPushTab(viewer,ierr);CHKERRQ(ierr)
 57:       call ISView(labelIS, viewer, ierr);CHKERRQ(ierr)
 58: !      call PetscViewerASCIIPopTab(viewer,ierr);CHKERRQ(ierr)
 59:       call ISDestroy(labelIS, ierr);CHKERRQ(ierr)
 60:       call PetscViewerASCIIPrintf(viewer, "\n", ierr);CHKERRQ(ierr)
 61:     end do

 63:     call PetscViewerASCIIPrintf(viewer,"\n\nCell Set label IS\n",ierr);CHKERRQ(ierr)
 64:     call DMGetLabel(dm, "Cell Sets", label, ierr);CHKERRQ(ierr)
 65:     call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr)
 66:     call ISView(labelIS, viewer, ierr);CHKERRQ(ierr)
 67:     call ISDestroy(labelIS, ierr);CHKERRQ(ierr)
 68:   end subroutine viewLabels
 69: end program ex1F90

 71: !/*TEST
 72: !
 73: !  test:
 74: !    suffix: 0
 75: !    args: -i ${wPETSC_DIR}/share/petsc/datafiles/meshes/blockcylinder-50.exo -interpolate
 76: !    requires: exodusii
 77: !
 78: !TEST*/