initialize Function

private function initialize(self, format, filename, mesh_topology, is_volatile, nx1, nx2, ny1, ny2, nz1, nz2) result(error)

Type Bound

vtk_file

Arguments

Type IntentOptional Attributes Name
class(vtk_file), intent(inout) :: self
character(len=*), intent(in) :: format
character(len=*), intent(in) :: filename
character(len=*), intent(in) :: mesh_topology
logical, intent(in), optional :: is_volatile
integer(kind=I4P), intent(in), optional :: nx1
integer(kind=I4P), intent(in), optional :: nx2
integer(kind=I4P), intent(in), optional :: ny1
integer(kind=I4P), intent(in), optional :: ny2
integer(kind=I4P), intent(in), optional :: nz1
integer(kind=I4P), intent(in), optional :: nz2

Return Value integer(kind=I4P)


Calls

proc~~initialize~5~~CallsGraph proc~initialize~5 vtk_file%initialize initialize initialize proc~initialize~5->initialize proc~b64_init b64_init proc~initialize~5->proc~b64_init proc~chars string%chars proc~initialize~5->proc~chars proc~penf_init penf_init proc~initialize~5->proc~penf_init proc~upper~2 string%upper proc~initialize~5->proc~upper~2 proc~b64_init->proc~penf_init proc~check_endian check_endian proc~penf_init->proc~check_endian

Called by

proc~~initialize~5~~CalledByGraph proc~initialize~5 vtk_file%initialize proc~write_check write_check proc~write_check->proc~initialize~5 proc~write_slave write_slave proc~write_slave->proc~initialize~5 proc~write_vts write_vts proc~write_vts->proc~initialize~5 program~vtk_fortran_write_vtm vtk_fortran_write_vtm program~vtk_fortran_write_vtm->proc~initialize~5 program~vtk_fortran_write_vtr vtk_fortran_write_vtr program~vtk_fortran_write_vtr->proc~initialize~5 program~vtk_fortran_write_vts vtk_fortran_write_vts program~vtk_fortran_write_vts->proc~initialize~5 program~vtk_fortran_write_vtu vtk_fortran_write_vtu program~vtk_fortran_write_vtu->proc~initialize~5 program~vtk_fortran_write_vtu~2 vtk_fortran_write_vtu program~vtk_fortran_write_vtu~2->proc~initialize~5 program~vtk_fortran_write_pvts vtk_fortran_write_pvts program~vtk_fortran_write_pvts->proc~write_vts program~vtk_fortran_write_volatile vtk_fortran_write_volatile program~vtk_fortran_write_volatile->proc~write_check program~vtk_fortran_write_volatile->proc~write_slave

Source Code

   function initialize(self, format, filename, mesh_topology, is_volatile, nx1, nx2, ny1, ny2, nz1, nz2) result(error)
   !< Initialize file (writer).
   !<
   !< @note This function must be the first to be called.
   !<
   !<### Supported output formats are (the passed specifier value is case insensitive):
   !<
   !<- ASCII: data are saved in ASCII format;
   !<- BINARY: data are saved in base64 encoded format;
   !<- RAW: data are saved in raw-binary format in the appended tag of the XML file;
   !<- BINARY-APPENDED: data are saved in base64 encoded format in the appended tag of the XML file.
   !<
   !<### Supported topologies are:
   !<
   !<- RectilinearGrid;
   !<- StructuredGrid;
   !<- UnstructuredGrid.
   !<
   !<### Example of usage
   !<
   !<```fortran
   !< type(vtk_file) :: vtk
   !< integer(I4P)   :: nx1, nx2, ny1, ny2, nz1, nz2
   !< ...
   !< error = vtk%initialize('BINARY','XML_RECT_BINARY.vtr','RectilinearGrid',nx1=nx1,nx2=nx2,ny1=ny1,ny2=ny2,nz1=nz1,nz2=nz2)
   !< ...
   !<```
   !< @note The file extension is necessary in the file name. The XML standard has different extensions for each
   !< different topologies (e.g. *vtr* for rectilinear topology). See the VTK-standard file for more information.
   class(vtk_file), intent(inout)        :: self          !< VTK file.
   character(*),    intent(in)           :: format        !< File format: ASCII, BINARY, RAW or BINARY-APPENDED.
   character(*),    intent(in)           :: filename      !< File name.
   character(*),    intent(in)           :: mesh_topology !< Mesh topology.
   logical,         intent(in), optional :: is_volatile   !< Flag to check volatile writer.
   integer(I4P),    intent(in), optional :: nx1           !< Initial node of x axis.
   integer(I4P),    intent(in), optional :: nx2           !< Final node of x axis.
   integer(I4P),    intent(in), optional :: ny1           !< Initial node of y axis.
   integer(I4P),    intent(in), optional :: ny2           !< Final node of y axis.
   integer(I4P),    intent(in), optional :: nz1           !< Initial node of z axis.
   integer(I4P),    intent(in), optional :: nz2           !< Final node of z axis.
   integer(I4P)                          :: error         !< Error status.
   type(string)                          :: fformat       !< File format.

   if (.not.is_initialized) call penf_init
   if (.not.is_b64_initialized) call b64_init
   fformat = trim(adjustl(format))
   fformat = fformat%upper()
   if (allocated(self%xml_writer)) deallocate(self%xml_writer)
   select case(fformat%chars())
   case('ASCII')
      allocate(xml_writer_ascii_local :: self%xml_writer)
   case('BINARY-APPENDED', 'RAW')
      allocate(xml_writer_appended :: self%xml_writer)
   case('BINARY')
      allocate(xml_writer_binary_local :: self%xml_writer)
   case default
      error = 1
   endselect
   error = self%xml_writer%initialize(format=format, filename=filename, mesh_topology=mesh_topology, &
                                      is_volatile=is_volatile,                                       &
                                      nx1=nx1, nx2=nx2, ny1=ny1, ny2=ny2, nz1=nz1, nz2=nz2)
   endfunction initialize