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