1: #include "petsc/finclude/petsc.h"
  2: program ex95f90
  3:   use petsc
  4:   implicit none
  5: #include "exodusII.inc"

  7:   PetscBool :: flg
  8:   integer :: nNodalVar = 4
  9:   integer :: nZonalVar = 3
 10:   integer :: i

 12:   PetscErrorCode :: ierr
 13:   type(tDM) :: dm, pdm
 14:   character(len=PETSC_MAX_PATH_LEN) :: ifilename, ofilename, IOBuffer
 15:   PetscInt, parameter :: order = 1
 16:   type(tPetscViewer) :: viewer
 17:   character(len=MXNAME), dimension(4) :: nodalVarName = ["U_x  ", "U_y  ", "Alpha", "Beta "]
 18:   character(len=MXNAME), dimension(3) :: zonalVarName = ["Sigma_11", "Sigma_12", "Sigma_22"]
 19:   character(len=MXNAME) :: varName

 21:   PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))

 23:   PetscCallA(PetscOptionsBegin(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, 'PetscViewer_ExodusII test', 'ex95f90', ierr))
 24:   PetscCallA(PetscOptionsString("-i", "Filename to read", "ex95f90", ifilename, ifilename, flg, ierr))
 25:   PetscCheckA(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, 'missing input file name -i ')
 26:   PetscCallA(PetscOptionsString("-o", "Filename to write", "ex95f90", ofilename, ofilename, flg, ierr))
 27:   PetscCheckA(flg, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, 'missing output file name -o 
')
 28:   PetscCallA(PetscOptionsEnd(ierr))

 30:   ! Read the mesh in any supported format
 31:   PetscCallA(DMPlexCreateFromFile(PETSC_COMM_WORLD, ifilename, PETSC_NULL_CHARACTER, PETSC_TRUE, dm, ierr))
 32:   PetscCallA(DMPlexDistributeSetDefault(dm, PETSC_FALSE, ierr))
 33:   PetscCallA(DMSetFromOptions(dm, ierr))
 34:   PetscCallA(PetscObjectSetName(dm, "ex95f90", ierr))
 35:   PetscCallA(DMViewFromOptions(dm, PETSC_NULL_OBJECT, '-dm_view', ierr))

 37:   ! enable exodus debugging information
 38: #ifdef PETSC_USE_DEBUG
 39:   PetscCallA(exopts(EXVRBS + EXDEBG, ierr))
 40: #endif

 42:   ! Create the exodus file
 43:   PetscCallA(PetscViewerExodusIIOpen(PETSC_COMM_WORLD, ofilename, FILE_MODE_WRITE, viewer, ierr))

 45:   ! Save the geometry to the file, erasing all previous content
 46:   PetscCallA(PetscViewerExodusIISetOrder(viewer, order, ierr))
 47:   PetscCallA(DMView(dm, viewer, ierr))
 48:   PetscCallA(PetscViewerView(viewer, PETSC_VIEWER_STDOUT_WORLD, ierr))
 49:   PetscCall(PetscViewerFlush(viewer, ierr))

 51:   PetscCallA(DMPlexDistribute(dm, 0_PETSC_INT_KIND, PETSC_NULL_SF, pdm, ierr))
 52:   if (pdm /= PETSC_NULL_DM) then
 53:     pdm = dm
 54:   end if

 56:   ! Testing Variable Number
 57:   PetscCallA(PetscViewerExodusIISetZonalVariable(viewer, nZonalVar, ierr))
 58:   nZonalVar = -1
 59:   PetscCallA(PetscViewerExodusIIGetZonalVariable(viewer, nZonalVar, ierr))
 60:   write (IOBuffer, '("Number of zonal variables:", I2,"\n")') nZonalVar
 61:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))

 63:   PetscCallA(PetscViewerExodusIISetNodalVariable(viewer, nNodalVar, ierr))
 64:   nNodalVar = -1
 65:   PetscCallA(PetscViewerExodusIIGetNodalVariable(viewer, nNodalVar, ierr))
 66:   write (IOBuffer, '("Number of nodal variables:", I2,"\n")') nNodalVar
 67:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))
 68:   PetscCallA(PetscViewerView(viewer, PETSC_VIEWER_STDOUT_WORLD, ierr))

 70:   ! Test of PetscViewerExodusIISet[Nodal/Zonal]VariableName
 71:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, "Testing PetscViewerExodusIISet[Nodal/Zonal]VariableName\n", ierr))
 72:   do i = 1, nZonalVar
 73:     PetscCallA(PetscViewerExodusIISetZonalVariableName(viewer, i - 1, zonalVarName(i), ierr))
 74:   end do
 75:   do i = 1, nNodalVar
 76:     PetscCallA(PetscViewerExodusIISetNodalVariableName(viewer, i - 1, nodalVarName(i), ierr))
 77:   end do
 78:   PetscCall(PetscViewerFlush(viewer, ierr))
 79:   PetscCallA(PetscViewerView(viewer, PETSC_VIEWER_STDOUT_WORLD, ierr))

 81:   do i = 1, nZonalVar
 82:     PetscCallA(PetscViewerExodusIIGetZonalVariableName(viewer, i - 1, varName, ierr))
 83:     write (IOBuffer, '("   zonal variable:", I2,": ",A,"\n")') i, varName
 84:     PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))
 85:   end do
 86:   do i = 1, nNodalVar
 87:     PetscCallA(PetscViewerExodusIIGetNodalVariableName(viewer, i - 1, varName, ierr))
 88:     write (IOBuffer, '("   nodal variable:", I2,": ",A,"\n")') i, varName
 89:     PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))
 90:   end do
 91:   PetscCallA(PetscViewerDestroy(viewer, ierr))

 93:   ! Test of PetscViewerExodusIIGet[Nodal/Zonal]VariableName
 94:   nZonalVar = -1
 95:   nNodalVar = -1
 96:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, "\n\nReopenning the output file in Read-only mode\n", ierr))
 97:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, "Testing PetscViewerExodusIIGet[Nodal/Zonal]VariableName\n", ierr))
 98:   PetscCallA(PetscViewerExodusIIOpen(PETSC_COMM_WORLD, ofilename, FILE_MODE_APPEND, viewer, ierr))
 99:   PetscCallA(PetscViewerExodusIISetOrder(viewer, order, ierr))
100:   PetscCallA(PetscViewerExodusIIGetZonalVariable(viewer, nZonalVar, ierr))
101:   PetscCallA(PetscViewerExodusIIGetNodalVariable(viewer, nNodalVar, ierr))

103:   do i = 1, nZonalVar
104:     PetscCallA(PetscViewerExodusIIGetZonalVariableName(viewer, i - 1, varName, ierr))
105:     write (IOBuffer, '("   zonal variable:", I2,": ",A,"\n")') i, varName
106:     PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))
107:   end do
108:   do i = 1, nNodalVar
109:     PetscCallA(PetscViewerExodusIIGetNodalVariableName(viewer, i - 1, varName, ierr))
110:     write (IOBuffer, '("   nodal variable:", I2,": ",A,"\n")') i, varName
111:     PetscCallA(PetscPrintf(PETSC_COMM_WORLD, IOBuffer, ierr))
112:   end do

114:   PetscCallA(DMDestroy(dm, ierr))
115:   PetscCallA(PetscViewerDestroy(viewer, ierr))
116:   PetscCallA(PetscFinalize(ierr))
117: end program ex95f90

119: !/*TEST
120: !
121: !  build:
122: !    requires: exodusii pnetcdf !complex
123: !  test:
124: !    suffix: 0
125: !    nsize: 1
126: !    args: -i ${wPETSC_DIR}/share/petsc/datafiles/meshes/FourSquareT-large.exo -o FourSquareT-large_out.exo
127: !
128: !TEST*/