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=2048) :: filename 9 integer,parameter :: len=2048 10 PetscBool :: interpolate = PETSC_FALSE 11 PetscBool :: flg 12 PetscErrorCode :: ierr 13 PetscInt :: izero 14 izero = 0 15 16 call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 17 if (ierr .ne. 0) then 18 print*,'Unable to initialize PETSc' 19 stop 20 endif 21 call PetscOptionsGetString(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-i",filename,flg,ierr);CHKERRA(ierr) 22 call PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-interpolate",interpolate,flg,ierr);CHKERRA(ierr) 23 24 call DMPlexCreateFromFile(PETSC_COMM_WORLD,filename,interpolate,dm,ierr);CHKERRA(ierr) 25 call DMPlexDistribute(dm,izero,PETSC_NULL_SF,dmDist,ierr);CHKERRA(ierr) 26 if (dmDist /= PETSC_NULL_DM) then 27 call DMDestroy(dm,ierr);CHKERRA(ierr) 28 dm = dmDist 29 end if 30 31 call ViewLabels(dm,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr) 32 call DMDestroy(dm,ierr);CHKERRA(ierr) 33 call PetscFinalize(ierr) 34 35contains 36 subroutine ViewLabels(dm,viewer,ierr) 37 type(tDM) :: dm 38 type(tPetscViewer) :: viewer 39 PetscErrorCode :: ierr 40 41 DMLabel :: label 42 type(tIS) :: labelIS 43 character(len=2048) :: labelName,IObuffer 44 PetscInt :: numLabels,l 45 46 call DMGetNumLabels(dm, numLabels, ierr);CHKERRQ(ierr); 47 write(IObuffer,*) 'Number of labels: ', numLabels, '\n' 48 call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr) 49 do l = 0, numLabels-1 50 call DMGetLabelName(dm, l, labelName, ierr);CHKERRQ(ierr) 51 write(IObuffer,*) 'label ',l,' name: ',trim(labelName),'\n' 52 call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr) 53 54 call PetscViewerASCIIPrintf(viewer, "IS of values\n", ierr);CHKERRQ(ierr) 55 call DMGetLabel(dm, labelName, label, ierr);CHKERRQ(ierr) 56 call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr) 57! call PetscViewerASCIIPushTab(viewer,ierr);CHKERRQ(ierr) 58 call ISView(labelIS, viewer, ierr);CHKERRQ(ierr) 59! call PetscViewerASCIIPopTab(viewer,ierr);CHKERRQ(ierr) 60 call ISDestroy(labelIS, ierr);CHKERRQ(ierr) 61 call PetscViewerASCIIPrintf(viewer, "\n", ierr);CHKERRQ(ierr) 62 end do 63 64 call PetscViewerASCIIPrintf(viewer,"\n\nCell Set label IS\n",ierr);CHKERRQ(ierr) 65 call DMGetLabel(dm, "Cell Sets", label, ierr);CHKERRQ(ierr) 66 call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr) 67 call ISView(labelIS, viewer, ierr);CHKERRQ(ierr) 68 call ISDestroy(labelIS, ierr);CHKERRQ(ierr) 69 end subroutine viewLabels 70end program ex1F90 71 72!/*TEST 73! 74! test: 75! suffix: 0 76! args: -i ${wPETSC_DIR}/share/petsc/datafiles/meshes/blockcylinder-50.exo -interpolate 77! requires: exodusii 78! 79!TEST*/ 80