1program ex1f90 2#include <petsc/finclude/petscdmlabel.h> 3 use petscdm 4 use petscdmlabel 5 implicit NONE 6 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 14 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) 22 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 29 30 call ViewLabels(dm,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr) 31 call DMDestroy(dm,ierr);CHKERRA(ierr) 32 call PetscFinalize(ierr) 33 34contains 35 subroutine ViewLabels(dm,viewer,ierr) 36 type(tDM) :: dm 37 type(tPetscViewer) :: viewer 38 PetscErrorCode :: ierr 39 40 DMLabel :: label 41 type(tIS) :: labelIS 42 character(len=PETSC_MAX_PATH_LEN):: labelName,IObuffer 43 PetscInt :: numLabels,l 44 45 call DMGetNumLabels(dm, numLabels, ierr);CHKERRQ(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) 52 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 62 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 69end program ex1F90 70 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*/ 79