xref: /petsc/src/dm/label/tutorials/ex1f90.F90 (revision d8606c274c09e255c003062beb17b1be973467bc)
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
15*d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
16*d8606c27SBarry Smith  PetscCallA(PetscOptionsGetString(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-i",filename,flg,ierr))
17*d8606c27SBarry Smith  PetscCallA(PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-interpolate",interpolate,flg,ierr))
18c4762a1bSJed Brown
19*d8606c27SBarry Smith  PetscCallA(DMPlexCreateFromFile(PETSC_COMM_WORLD,filename,"ex1f90_plex",interpolate,dm,ierr))
20*d8606c27SBarry Smith  PetscCallA(DMPlexDistribute(dm,izero,PETSC_NULL_SF,dmDist,ierr))
21c4762a1bSJed Brown  if (dmDist /= PETSC_NULL_DM) then
22*d8606c27SBarry Smith    PetscCallA(DMDestroy(dm,ierr))
23c4762a1bSJed Brown    dm = dmDist
24c4762a1bSJed Brown  end if
25c4762a1bSJed Brown
26*d8606c27SBarry Smith  PetscCallA(ViewLabels(dm,PETSC_VIEWER_STDOUT_WORLD,ierr))
27*d8606c27SBarry Smith  PetscCallA(DMDestroy(dm,ierr))
28*d8606c27SBarry 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
41*d8606c27SBarry Smith    PetscCall(DMGetNumLabels(dm, numLabels, ierr))
42c4762a1bSJed Brown    write(IObuffer,*) 'Number of labels: ', numLabels, '\n'
43*d8606c27SBarry Smith    PetscCall(PetscViewerASCIIPrintf(viewer, IObuffer, ierr))
44c4762a1bSJed Brown    do l = 0, numLabels-1
45*d8606c27SBarry Smith      PetscCall(DMGetLabelName(dm, l, labelName, ierr))
46c4762a1bSJed Brown      write(IObuffer,*) 'label ',l,' name: ',trim(labelName),'\n'
47*d8606c27SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, IObuffer, ierr))
48c4762a1bSJed Brown
49*d8606c27SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, "IS of values\n", ierr))
50*d8606c27SBarry Smith      PetscCall(DMGetLabel(dm, labelName, label, ierr))
51*d8606c27SBarry Smith      PetscCall(DMLabelGetValueIS(label, labelIS, ierr))
52*d8606c27SBarry Smith!      PetscCall(PetscViewerASCIIPushTab(viewer,ierr))
53*d8606c27SBarry Smith      PetscCall(ISView(labelIS, viewer, ierr))
54*d8606c27SBarry Smith!      PetscCall(PetscViewerASCIIPopTab(viewer,ierr))
55*d8606c27SBarry Smith      PetscCall(ISDestroy(labelIS, ierr))
56*d8606c27SBarry Smith      PetscCall(PetscViewerASCIIPrintf(viewer, "\n", ierr))
57c4762a1bSJed Brown    end do
58c4762a1bSJed Brown
59*d8606c27SBarry Smith    PetscCall(PetscViewerASCIIPrintf(viewer,"\n\nCell Set label IS\n",ierr))
60*d8606c27SBarry Smith    PetscCall(DMGetLabel(dm, "Cell Sets", label, ierr))
61*d8606c27SBarry Smith    PetscCall(DMLabelGetValueIS(label, labelIS, ierr))
62*d8606c27SBarry Smith    PetscCall(ISView(labelIS, viewer, ierr))
63*d8606c27SBarry 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