xref: /petsc/src/dm/label/tutorials/ex1f90.F90 (revision 62ac926ddc3e036a30b4ea12e742c29a0093bc2f)
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
8*62ac926dSPierre 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
15c4762a1bSJed Brown  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
16c4762a1bSJed Brown    if (ierr .ne. 0) then
17c4762a1bSJed Brown    print*,'Unable to initialize PETSc'
18c4762a1bSJed Brown    stop
19c4762a1bSJed Brown  endif
20c4762a1bSJed Brown  call PetscOptionsGetString(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-i",filename,flg,ierr);CHKERRA(ierr)
21c4762a1bSJed Brown  call PetscOptionsGetBool(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,"-interpolate",interpolate,flg,ierr);CHKERRA(ierr)
22c4762a1bSJed Brown
23d21b9a37SPierre Jolivet  call DMPlexCreateFromFile(PETSC_COMM_WORLD,filename,interpolate,dm,ierr);CHKERRA(ierr)
24c4762a1bSJed Brown  call DMPlexDistribute(dm,izero,PETSC_NULL_SF,dmDist,ierr);CHKERRA(ierr)
25c4762a1bSJed Brown  if (dmDist /= PETSC_NULL_DM) then
26c4762a1bSJed Brown    call DMDestroy(dm,ierr);CHKERRA(ierr)
27c4762a1bSJed Brown    dm = dmDist
28c4762a1bSJed Brown  end if
29c4762a1bSJed Brown
30c4762a1bSJed Brown  call ViewLabels(dm,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
31c4762a1bSJed Brown  call DMDestroy(dm,ierr);CHKERRA(ierr)
32c4762a1bSJed Brown  call PetscFinalize(ierr)
33c4762a1bSJed Brown
34c4762a1bSJed Browncontains
35c4762a1bSJed Brown  subroutine ViewLabels(dm,viewer,ierr)
36c4762a1bSJed Brown    type(tDM)                        :: dm
37c4762a1bSJed Brown    type(tPetscViewer)               :: viewer
38c4762a1bSJed Brown    PetscErrorCode                   :: ierr
39c4762a1bSJed Brown
40c4762a1bSJed Brown    DMLabel                          :: label
41c4762a1bSJed Brown    type(tIS)                        :: labelIS
42*62ac926dSPierre Jolivet    character(len=PETSC_MAX_PATH_LEN):: labelName,IObuffer
43c4762a1bSJed Brown    PetscInt                         :: numLabels,l
44c4762a1bSJed Brown
45c4762a1bSJed Brown    call DMGetNumLabels(dm, numLabels, ierr);CHKERRQ(ierr);
46c4762a1bSJed Brown    write(IObuffer,*) 'Number of labels: ', numLabels, '\n'
47c4762a1bSJed Brown    call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr)
48c4762a1bSJed Brown    do l = 0, numLabels-1
49c4762a1bSJed Brown      call DMGetLabelName(dm, l, labelName, ierr);CHKERRQ(ierr)
50c4762a1bSJed Brown      write(IObuffer,*) 'label ',l,' name: ',trim(labelName),'\n'
51c4762a1bSJed Brown      call PetscViewerASCIIPrintf(viewer, IObuffer, ierr);CHKERRQ(ierr)
52c4762a1bSJed Brown
53c4762a1bSJed Brown      call PetscViewerASCIIPrintf(viewer, "IS of values\n", ierr);CHKERRQ(ierr)
54c4762a1bSJed Brown      call DMGetLabel(dm, labelName, label, ierr);CHKERRQ(ierr)
55c4762a1bSJed Brown      call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr)
56c4762a1bSJed Brown!      call PetscViewerASCIIPushTab(viewer,ierr);CHKERRQ(ierr)
57c4762a1bSJed Brown      call ISView(labelIS, viewer, ierr);CHKERRQ(ierr)
58c4762a1bSJed Brown!      call PetscViewerASCIIPopTab(viewer,ierr);CHKERRQ(ierr)
59c4762a1bSJed Brown      call ISDestroy(labelIS, ierr);CHKERRQ(ierr)
60c4762a1bSJed Brown      call PetscViewerASCIIPrintf(viewer, "\n", ierr);CHKERRQ(ierr)
61c4762a1bSJed Brown    end do
62c4762a1bSJed Brown
63c4762a1bSJed Brown    call PetscViewerASCIIPrintf(viewer,"\n\nCell Set label IS\n",ierr);CHKERRQ(ierr)
64c4762a1bSJed Brown    call DMGetLabel(dm, "Cell Sets", label, ierr);CHKERRQ(ierr)
65c4762a1bSJed Brown    call DMLabelGetValueIS(label, labelIS, ierr);CHKERRQ(ierr)
66c4762a1bSJed Brown    call ISView(labelIS, viewer, ierr);CHKERRQ(ierr)
67c4762a1bSJed Brown    call ISDestroy(labelIS, ierr);CHKERRQ(ierr)
68c4762a1bSJed Brown  end subroutine viewLabels
69c4762a1bSJed Brownend program ex1F90
70c4762a1bSJed Brown
71c4762a1bSJed Brown!/*TEST
72c4762a1bSJed Brown!
73c4762a1bSJed Brown!  test:
74c4762a1bSJed Brown!    suffix: 0
75c4762a1bSJed Brown!    args: -i ${wPETSC_DIR}/share/petsc/datafiles/meshes/blockcylinder-50.exo -interpolate
76c4762a1bSJed Brown!    requires: exodusii
77c4762a1bSJed Brown!
78c4762a1bSJed Brown!TEST*/
79