xref: /petsc/src/dm/label/tutorials/ex1f90.F90 (revision 9b88ac225e01f016352a5f4cd90e158abe5f5675)
1c4762a1bSJed Brown#include <petsc/finclude/petscdmlabel.h>
2c5e229c2SMartin Diehlprogram ex1f90
3c4762a1bSJed Brown  use petscdm
4*02c639afSMartin Diehl  implicit none
5c4762a1bSJed Brown
6c4762a1bSJed Brown  type(tDM)                         :: dm, dmDist
762ac926dSPierre Jolivet  character(len=PETSC_MAX_PATH_LEN) :: filename
8c4762a1bSJed Brown  PetscBool                         :: interpolate = PETSC_FALSE
9c4762a1bSJed Brown  PetscBool                         :: flg
10c4762a1bSJed Brown  PetscErrorCode                    :: ierr
11c4762a1bSJed Brown  PetscInt                          :: izero
12c4762a1bSJed Brown  izero = 0
13c4762a1bSJed Brown
14d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
15dcb3e689SBarry Smith  PetscCallA(PetscOptionsGetString(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-i', filename, flg, ierr))
16dcb3e689SBarry Smith  PetscCallA(PetscOptionsGetBool(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-interpolate', interpolate, flg, ierr))
17c4762a1bSJed Brown
18dcb3e689SBarry Smith  PetscCallA(DMPlexCreateFromFile(PETSC_COMM_WORLD, filename, 'ex1f90_plex', interpolate, dm, ierr))
19d8606c27SBarry Smith  PetscCallA(DMPlexDistribute(dm, izero, PETSC_NULL_SF, dmDist, ierr))
205d83a8b1SBarry Smith  if (.not. PetscObjectIsNull(dmDist)) then
21d8606c27SBarry Smith    PetscCallA(DMDestroy(dm, ierr))
22c4762a1bSJed Brown    dm = dmDist
23c4762a1bSJed Brown  end if
24c4762a1bSJed Brown
25d8606c27SBarry Smith  PetscCallA(ViewLabels(dm, PETSC_VIEWER_STDOUT_WORLD, ierr))
26d8606c27SBarry Smith  PetscCallA(DMDestroy(dm, ierr))
27d8606c27SBarry Smith  PetscCallA(PetscFinalize(ierr))
28c4762a1bSJed Brown
29c4762a1bSJed Browncontains
30c4762a1bSJed Brown  subroutine ViewLabels(dm, viewer, ierr)
31c4762a1bSJed Brown    type(tDM)                        :: dm
32c4762a1bSJed Brown    type(tPetscViewer)               :: viewer
33c4762a1bSJed Brown    PetscErrorCode                   :: ierr
34c4762a1bSJed Brown
35c4762a1bSJed Brown    DMLabel                          :: label
36c4762a1bSJed Brown    type(tIS)                        :: labelIS
3762ac926dSPierre Jolivet    character(len=PETSC_MAX_PATH_LEN):: labelName, IObuffer
38c4762a1bSJed Brown    PetscInt                         :: numLabels, l
39c4762a1bSJed Brown
40d8606c27SBarry Smith    PetscCall(DMGetNumLabels(dm, numLabels, ierr))
41c4762a1bSJed Brown    write (IObuffer, *) 'Number of labels: ', numLabels, '\n'
42d8606c27SBarry Smith    PetscCall(PetscViewerASCIIPrintf(viewer, IObuffer, ierr))
43c4762a1bSJed Brown    do l = 0, numLabels - 1
44d8606c27SBarry Smith      PetscCall(DMGetLabelName(dm, l, labelName, ierr))
45c4762a1bSJed Brown      write (IObuffer, *) 'label ', l, ' name: ', trim(labelName), '\n'
46d8606c27SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, IObuffer, ierr))
47c4762a1bSJed Brown
48dcb3e689SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, 'IS of values\n', ierr))
49d8606c27SBarry Smith      PetscCall(DMGetLabel(dm, labelName, label, ierr))
50d8606c27SBarry Smith      PetscCall(DMLabelGetValueIS(label, labelIS, ierr))
51d8606c27SBarry Smith!      PetscCall(PetscViewerASCIIPushTab(viewer,ierr))
52d8606c27SBarry Smith      PetscCall(ISView(labelIS, viewer, ierr))
53d8606c27SBarry Smith!      PetscCall(PetscViewerASCIIPopTab(viewer,ierr))
54d8606c27SBarry Smith      PetscCall(ISDestroy(labelIS, ierr))
55dcb3e689SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, '\n', ierr))
56c4762a1bSJed Brown    end do
57c4762a1bSJed Brown
58dcb3e689SBarry Smith    PetscCall(PetscViewerASCIIPrintf(viewer, '\n\nCell Set label IS\n', ierr))
59dcb3e689SBarry Smith    PetscCall(DMGetLabel(dm, 'Cell Sets', label, ierr))
60d8606c27SBarry Smith    PetscCall(DMLabelGetValueIS(label, labelIS, ierr))
61d8606c27SBarry Smith    PetscCall(ISView(labelIS, viewer, ierr))
62d8606c27SBarry Smith    PetscCall(ISDestroy(labelIS, ierr))
63c4762a1bSJed Brown  end subroutine viewLabels
64c4762a1bSJed Brownend program ex1F90
65c4762a1bSJed Brown
66c4762a1bSJed Brown!/*TEST
67c4762a1bSJed Brown!
68c4762a1bSJed Brown!  test:
69c4762a1bSJed Brown!    suffix: 0
7046ac1a18SMatthew G. Knepley!    args: -i ${wPETSC_DIR}/share/petsc/datafiles/meshes/blockcylinder-50.exo -interpolate
71c4762a1bSJed Brown!    requires: exodusii
72c4762a1bSJed Brown!
73c4762a1bSJed Brown!TEST*/
74