xref: /petsc/src/dm/label/tutorials/ex1f90.F90 (revision 25de42d4cc3a855a8011c4f7357362db9d1e1268)
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