xref: /petsc/src/dm/label/tutorials/ex1f90.F90 (revision c67b119c46b68366926a82dc9af25ba9ebb9c281)
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 (.not. PetscObjectIsNull(dmDist)) 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