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