Actual source code: ex1f90.F90
petsc-3.13.6 2020-09-29
Report Typos and Errors

      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=2048) :: filename
      9:   integer,parameter   :: len=2048
     10:   PetscBool           :: interpolate = PETSC_FALSE
     11:   PetscBool           :: flg
     12:   PetscErrorCode      :: ierr
     13:   PetscInt            :: izero
     14:   izero = 0

     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)

     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

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

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

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

     46:     call DMGetNumLabels(dm, numLabels, 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)

     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

     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
     70: end program ex1F90

     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*/