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