diff --git a/code/math.f90 b/code/math.f90 index 48307503b..9c3d272a3 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -1232,10 +1232,14 @@ pure function math_Voigt66to3333(m66) integer(pInt) :: i,j forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) - math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) = invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) - math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) - math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) - math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) + math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) = & + invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) + math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = & + invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) + math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = & + invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) + math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = & + invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j) end forall end function math_Voigt66to3333 @@ -1251,10 +1255,10 @@ function math_qRand() real(pReal), dimension(3) :: rnd call halton(3_pInt,rnd) - math_qRand(1) = cos(2.0_pReal*pi*rnd(1))*sqrt(rnd(3)) - math_qRand(2) = sin(2.0_pReal*pi*rnd(2))*sqrt(1.0_pReal-rnd(3)) - math_qRand(3) = cos(2.0_pReal*pi*rnd(2))*sqrt(1.0_pReal-rnd(3)) - math_qRand(4) = sin(2.0_pReal*pi*rnd(1))*sqrt(rnd(3)) + math_qRand(1) = cos(2.0_pReal*PI*rnd(1))*sqrt(rnd(3)) + math_qRand(2) = sin(2.0_pReal*PI*rnd(2))*sqrt(1.0_pReal-rnd(3)) + math_qRand(3) = cos(2.0_pReal*PI*rnd(2))*sqrt(1.0_pReal-rnd(3)) + math_qRand(4) = sin(2.0_pReal*PI*rnd(1))*sqrt(rnd(3)) end function math_qRand diff --git a/code/mesh.f90 b/code/mesh.f90 index 53771fb0a..b3f46a228 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -5089,7 +5089,8 @@ end subroutine mesh_build_FEdata !-------------------------------------------------------------------------------------------------- subroutine mesh_write_cellGeom use DAMASK_interface, only: & - getSolverJobName + getSolverJobName, & + getSolverWorkingDirectoryName use Lib_VTK_IO, only: & VTK_ini, & VTK_geo, & @@ -5116,16 +5117,16 @@ subroutine mesh_write_cellGeom enddo err = VTK_ini(output_format = 'ASCII', & - title=trim(getSolverJobName())//' cell mesh', & - filename = trim(getSolverJobName())//'_ipbased.vtk', & - mesh_topology = 'UNSTRUCTURED_GRID') + title=trim(getSolverJobName())//' cell mesh', & + filename = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'_ipbased.vtk', & + mesh_topology = 'UNSTRUCTURED_GRID') err = VTK_geo(NN = mesh_Ncellnodes, & - X = mesh_cellnode(1,:), & - Y = mesh_cellnode(2,:), & - Z = mesh_cellnode(3,:)) + X = mesh_cellnode(1,:), & + Y = mesh_cellnode(2,:), & + Z = mesh_cellnode(3,:)) err = VTK_con(NC = mesh_Ncells, & - connect = cellconnection(1:j), & - cell_type = celltype) + connect = cellconnection(1:j), & + cell_type = celltype) err = VTK_end() end subroutine mesh_write_cellGeom @@ -5136,7 +5137,8 @@ end subroutine mesh_write_cellGeom !-------------------------------------------------------------------------------------------------- subroutine mesh_write_elemGeom use DAMASK_interface, only: & - getSolverJobName + getSolverJobName, & + getSolverWorkingDirectoryName use Lib_VTK_IO, only: & VTK_ini, & VTK_geo, & @@ -5160,16 +5162,16 @@ subroutine mesh_write_elemGeom enddo err = VTK_ini(output_format = 'ASCII', & - title=trim(getSolverJobName())//' element mesh', & - filename = trim(getSolverJobName())//'_nodebased.vtk', & - mesh_topology = 'UNSTRUCTURED_GRID') + title=trim(getSolverJobName())//' element mesh', & + filename = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName()//'_nodebased.vtk', & + mesh_topology = 'UNSTRUCTURED_GRID') err = VTK_geo(NN = mesh_Nnodes, & - X = mesh_node0(1,1:mesh_Nnodes), & - Y = mesh_node0(2,1:mesh_Nnodes), & - Z = mesh_node0(3,1:mesh_Nnodes)) + X = mesh_node0(1,1:mesh_Nnodes), & + Y = mesh_node0(2,1:mesh_Nnodes), & + Z = mesh_node0(3,1:mesh_Nnodes)) err = VTK_con(NC = mesh_Nelems, & - connect = elementconnection(1:i), & - cell_type = elemtype) + connect = elementconnection(1:i), & + cell_type = elemtype) err = VTK_end() end subroutine mesh_write_elemGeom diff --git a/lib/Lib_VTK_IO.f90 b/lib/Lib_VTK_IO.f90 index 054327ffc..d38313223 100644 --- a/lib/Lib_VTK_IO.f90 +++ b/lib/Lib_VTK_IO.f90 @@ -67,11 +67,11 @@ !> - vtkMultiBlockDataSet; !> - Importers are \b missing. !> -!> @libvtk can handle multiple concurrent files, but it is not thread-safe (e.g. race conditions occur into OpenMP -!> parallel framework). +!> @libvtk can handle multiple concurrent files and it is \b thread/processor-safe (meaning that can be safely used into +!> parallel frameworks as OpenMP or MPI). !> !> The library is an open source project, it is distributed under the GPL v3. Anyone is interest to use, to develop or -!> to contribute to Lib_VTK_IO is welcome. +!> to contribute to @libvtk is welcome. !> !> It can be found at: https://github.com/szaghi/Lib_VTK_IO !> @@ -112,13 +112,14 @@ !> kind-precision; to this aim @libvtk uses IR_Precision module. !> @author Stefano Zaghi !> @version 1.1 -!> @date 2013-03-28 +!> @date 2013-04-26 !> @par News !> - Correct bug affecting binary output; -!> - Implement concurrent multiple files IO capability; -!> - Implement FieldData tag for XML files, useful for tagging dataset with global auxiliary data, e.g. time, time step, ecc; -!> - Implement Parallel (Partitioned) XML files support (.pvtu,.pvts,.pvtr); -!> - Implement Driver testing program for providing practical examples of @libvtk usage. +!> - implement concurrent multiple files IO capability; +!> - implement FieldData tag for XML files, useful for tagging dataset with global auxiliary data, e.g. time, time step, ecc; +!> - implement Parallel (Partitioned) XML files support (.pvtu,.pvts,.pvtr); +!> - implement Driver testing program for providing practical examples of @libvtk usage; +!> - added support for parallel framework, namely OpenMP (thread-safe) and MPI (process-safe). !> @copyright GNU Public License version 3. !> @note The supported compilers are GNU gfortran 4.7.x (or higher) and Intel Fortran 12.x (or higher). @libvtk needs a modern !> compiler providing support for some Fortran standard 2003 features. @@ -142,8 +143,6 @@ !> the final XML file. Only when all XML formatting data have been written the scratch file is rewind !> and the binary data is saved in the final tag of XML file as \b raw data. This approach is not !> efficient. -!> @bug Thread-Safe: \n The @libvtk is not thread-safe: if used into a parallel multi-thread framework, e.g. OpenMP threads, -!> the IO operations are not safe and race conditions with unpredictable results happen. !> @ingroup Lib_VTK_IOLibrary module Lib_VTK_IO !----------------------------------------------------------------------------------------------------------------------------------- @@ -387,7 +386,7 @@ character(1), parameter:: end_rec = char(10) !< End-character for binary-record integer(I4P), parameter:: ascii = 0 !< Ascii-output-format parameter identifier. integer(I4P), parameter:: binary = 1 !< Binary-output-format parameter identifier. ! VTK file data: -type Type_VTK_File +type:: Type_VTK_File integer(I4P):: f = ascii !< Current output-format (initialized to ascii format). character(len=maxlen):: topology = '' !< Mesh topology. integer(I4P):: u = 0_I4P !< Logical unit. @@ -399,12 +398,14 @@ type Type_VTK_File #endif integer(I8P):: ioffset = 0_I8P !< Offset pointer. integer(I4P):: indent = 0_I4P !< Indent pointer. + contains + procedure, non_overridable:: byte_update ! Procedure for updating N_Byte and ioffset pointer. endtype Type_VTK_File type(Type_VTK_File), allocatable:: vtk(:) !< Global data of VTK files [1:Nvtk]. integer(I4P):: Nvtk = 0_I4P !< Number of (concurrent) VTK files. integer(I4P):: f = 0_I4P !< Current VTK file index. ! VTM file data: -type Type_VTM_File +type:: Type_VTM_File integer(I4P):: u = 0_I4P !< Logical unit. integer(I4P):: blk = 0_I4P !< Block index. integer(I4P):: indent = 0_I4P !< Indent pointer. @@ -413,9 +414,7 @@ type(Type_VTM_File):: vtm !< Global data of VTM files. !> @} !----------------------------------------------------------------------------------------------------------------------------------- contains - ! The library uses two auxiliary functions that are not connected with the VTK standard. These functions are private and so they - ! cannot be called outside the library. - + ! The library uses four auxiliary procedures that are private thus they cannot be called outside the library. !> @ingroup Lib_VTK_IOPrivateProcedure !> @{ !> @brief Function for getting a free logic unit. The users of @libvtk does not know which is the logical @@ -436,7 +435,7 @@ contains n1=1 do if ((n1/=stdout).AND.(n1/=stderr)) then - inquire (unit=n1,opened=lopen,iostat=ios) + inquire(unit=n1,opened=lopen,iostat=ios) if (ios==0) then if (.NOT.lopen) then Get_Unit = n1 ; if (present(Free_Unit)) Free_Unit = Get_Unit @@ -456,7 +455,7 @@ contains !> the case of the keywords passed to the functions: calling the function VTK_INI with the string !> E_IO = VTK_INI('Ascii',...) is equivalent to E_IO = VTK_INI('ASCII',...). !>@return Upper_Case - function Upper_Case(string) + elemental function Upper_Case(string) !--------------------------------------------------------------------------------------------------------------------------------- implicit none character(len=*), intent(IN):: string !< String to be converted. @@ -476,33 +475,38 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- endfunction Upper_Case - !> @brief Subroutine for updating vtk(f)%ioffset pointer. - subroutine ioffset_update(N_Byte) + !> @brief Subroutine for updating N_Byte and ioffset pointer. + elemental subroutine byte_update(vtk,N_Byte) !--------------------------------------------------------------------------------------------------------------------------------- implicit none + class(Type_VTK_File), intent(INOUT):: vtk !< Global data of VTK file. #ifdef HUGE - integer(I8P), intent(IN):: N_Byte !< Number of bytes saved. + integer(I8P), intent(IN):: N_Byte !< Number of bytes saved. #else - integer(I4P), intent(IN):: N_Byte !< Number of bytes saved. + integer(I4P), intent(IN):: N_Byte !< Number of bytes saved. #endif !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + vtk%N_Byte = N_Byte #ifdef HUGE - vtk(f)%ioffset = vtk(f)%ioffset + BYI8P + N_Byte + vtk%ioffset = vtk%ioffset + BYI8P + N_Byte #else - vtk(f)%ioffset = vtk(f)%ioffset + BYI4P + N_Byte + vtk%ioffset = vtk%ioffset + BYI4P + N_Byte #endif return !--------------------------------------------------------------------------------------------------------------------------------- - endsubroutine ioffset_update + endsubroutine byte_update !> @brief Subroutine for updating (adding and removing elements into) vtk array. - subroutine vtk_update(act) + pure subroutine vtk_update(act,cf,Nvtk,vtk) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - character(*), intent(IN):: act !< Action on vtk array: 'ADD' one more element, 'REMOVE' current element file. - type(Type_VTK_File), allocatable:: vtk_tmp(:) !< Temporary array of VTK files data. + character(*), intent(IN):: act !< Action: 'ADD' one more element, 'REMOVE' current element file. + integer(I4P), intent(INOUT):: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(INOUT):: Nvtk !< Number of (concurrent) VTK files. + type(Type_VTK_File), allocatable, intent(INOUT):: vtk(:) !< VTK files data. + type(Type_VTK_File), allocatable:: vtk_tmp(:) !< Temporary array of VTK files data. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- @@ -516,31 +520,31 @@ contains allocate(vtk(1:Nvtk)) vtk(1:Nvtk-1) = vtk_tmp deallocate(vtk_tmp) - f = Nvtk + cf = Nvtk else Nvtk = 1_I4P allocate(vtk(1:Nvtk)) - f = Nvtk + cf = Nvtk endif case('REMOVE') if (Nvtk>1_I4P) then allocate(vtk_tmp(1:Nvtk-1)) - if (f==Nvtk) then + if (cf==Nvtk) then vtk_tmp = vtk(1:Nvtk-1) else - vtk_tmp(1:f-1) = vtk(1 :f-1) - vtk_tmp(f: ) = vtk(f+1: ) + vtk_tmp(1 :cf-1) = vtk(1 :cf-1) + vtk_tmp(cf: ) = vtk(cf+1: ) endif deallocate(vtk) Nvtk = Nvtk - 1 allocate(vtk(1:Nvtk)) vtk = vtk_tmp deallocate(vtk_tmp) - f = 1_I4P + cf = 1_I4P else Nvtk = 0_I4P if (allocated(vtk)) deallocate(vtk) - f = Nvtk + cf = Nvtk endif endselect return @@ -578,60 +582,63 @@ contains character(*), intent(IN):: mesh_topology !< Mesh topology. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- if (.not.ir_initialized) call IR_Init - call vtk_update(act='add') - if (present(cf)) cf = f - vtk(f)%topology = trim(mesh_topology) + call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf + vtk(rf)%topology = trim(mesh_topology) select case(trim(Upper_Case(output_format))) case('ASCII') - vtk(f)%f = ascii - open(unit=Get_Unit(vtk(f)%u),file=trim(filename),form='FORMATTED',& + vtk(rf)%f = ascii + open(unit=Get_Unit(vtk(rf)%u),file=trim(filename),form='FORMATTED',& access='SEQUENTIAL',action='WRITE',status='REPLACE',iostat=E_IO) ! writing header of file - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'' if (endian==endianL) then - s_buffer = '' + s_buffer = '' else - s_buffer = '' + s_buffer = '' endif - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = 2 - select case(trim(vtk(f)%topology)) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = 2 + select case(trim(vtk(rf)%topology)) case('RectilinearGrid','StructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//' WholeExtent="'//& - trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & - trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//' WholeExtent="'//& + trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' case('UnstructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//'>' + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//'>' endselect - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 case('BINARY') - vtk(f)%f = binary - open(unit=Get_Unit(vtk(f)%u),file=trim(filename),form='UNFORMATTED',access='STREAM',action='WRITE',status='REPLACE',iostat=E_IO) + vtk(rf)%f = binary + open(unit=Get_Unit(vtk(rf)%u),file=trim(filename),& + form='UNFORMATTED',access='STREAM',action='WRITE',status='REPLACE',iostat=E_IO) ! writing header of file - write(unit=vtk(f)%u,iostat=E_IO)''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)''//end_rec if (endian==endianL) then - s_buffer = '' + s_buffer = '' else - s_buffer = '' + s_buffer = '' endif - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = 2 - select case(trim(vtk(f)%topology)) + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = 2 + select case(trim(vtk(rf)%topology)) case('RectilinearGrid','StructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//' WholeExtent="'//& - trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & - trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//' WholeExtent="'//& + trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' case('UnstructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//'>' + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//'>' endselect - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 ! opening the SCRATCH file used for appending raw binary data - open(unit=Get_Unit(vtk(f)%ua), form='UNFORMATTED', access='STREAM', action='READWRITE', status='SCRATCH', iostat=E_IO) - vtk(f)%ioffset = 0 ! initializing offset pointer + open(unit=Get_Unit(vtk(rf)%ua), form='UNFORMATTED', access='STREAM', action='READWRITE', status='SCRATCH', iostat=E_IO) + vtk(rf)%ioffset = 0 ! initializing offset pointer endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -647,24 +654,28 @@ contains integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). character(*), intent(IN):: fld_action !< Field data tag action: OPEN or CLOSE tag. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif select case(trim(Upper_Case(fld_action))) case('OPEN') - select case(vtk(f)%f) + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 case(binary) - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 endselect case('CLOSE') - select case(vtk(f)%f) + select case(vtk(rf)%f) case(ascii) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect endselect return @@ -681,22 +692,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''//& - trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + s_buffer=repeat(' ',vtk(rf)%indent)//''//& + trim(str(n=fld))//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYR8P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -712,22 +727,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''//& - trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + s_buffer=repeat(' ',vtk(rf)%indent)//''//& + trim(str(n=fld))//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYR4P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -743,22 +762,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''// & + s_buffer = repeat(' ',vtk(rf)%indent)//''// & trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYI8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I8',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYI8P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I8',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -774,22 +797,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''// & + s_buffer = repeat(' ',vtk(rf)%indent)//''// & trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYI4P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -805,22 +832,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''// & + s_buffer = repeat(' ',vtk(rf)%indent)//''// & trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYI2P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I2',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYI2P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I2',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -836,22 +867,26 @@ contains character(*), intent(IN):: fname !< Field data name. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//''// & + s_buffer = repeat(' ',vtk(rf)%indent)//''// & trim(str(n=fld))//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = BYI1P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I1',1_I4P - write(unit=vtk(f)%ua,iostat=E_IO)fld + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(BYI1P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I1',1_I4P + write(unit=vtk(rf)%ua,iostat=E_IO)fld endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -875,37 +910,41 @@ contains real(R8P), intent(IN):: Z(1:NN) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)// & + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)// & '' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NN*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',3*NN - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + trim(str(.true.,vtk(rf)%ioffset))//'"/>' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NN*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',3*NN + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -929,37 +968,41 @@ contains real(R4P), intent(IN):: Z(1:NN) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)// & + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)// & '' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NN*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',3*NN - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + trim(str(.true.,vtk(rf)%ioffset))//'"/>' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NN*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',3*NN + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -982,53 +1025,57 @@ contains real(R8P), intent(IN):: Z(nz1:nz2) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(X(n1),n1=nx1,nx2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(Y(n1),n1=ny1,ny2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(Z(n1),n1=nz1,nz2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(X(n1),n1=nx1,nx2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(Y(n1),n1=ny1,ny2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(Z(n1),n1=nz1,nz2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (nx2-nx1+1)*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',(nx2-nx1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),n1=nx1,nx2) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (ny2-ny1+1)*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',(ny2-ny1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(Y(n1),n1=ny1,ny2) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (nz2-nz1+1)*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',(nz2-nz1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(Z(n1),n1=nz1,nz2) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (nx2-nx1+1)*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',(nx2-nx1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),n1=nx1,nx2) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (ny2-ny1+1)*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',(ny2-ny1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(Y(n1),n1=ny1,ny2) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (nz2-nz1+1)*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',(nz2-nz1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(Z(n1),n1=nz1,nz2) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1051,53 +1098,57 @@ contains real(R4P), intent(IN):: Z(nz1:nz2) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(X(n1),n1=nx1,nx2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(Y(n1),n1=ny1,ny2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(Z(n1),n1=nz1,nz2) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(X(n1),n1=nx1,nx2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(Y(n1),n1=ny1,ny2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(Z(n1),n1=nz1,nz2) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (nx2-nx1+1)*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',(nx2-nx1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),n1=nx1,nx2) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (ny2-ny1+1)*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',(ny2-ny1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(Y(n1),n1=ny1,ny2) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = (nz2-nz1+1)*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',(nz2-nz1+1) - write(unit=vtk(f)%ua,iostat=E_IO)(Z(n1),n1=nz1,nz2) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (nx2-nx1+1)*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',(nx2-nx1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),n1=nx1,nx2) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (ny2-ny1+1)*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',(ny2-ny1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(Y(n1),n1=ny1,ny2) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = (nz2-nz1+1)*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',(nz2-nz1+1) + write(unit=vtk(rf)%ua,iostat=E_IO)(Z(n1),n1=nz1,nz2) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1116,33 +1167,37 @@ contains real(R8P), intent(IN):: Z(1:NN) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)// & + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)// & '' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NN*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',3*NN - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + trim(str(.true.,vtk(rf)%ioffset))//'"/>' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NN*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',3*NN + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1161,33 +1216,37 @@ contains real(R4P), intent(IN):: Z(1:NN) !< Z coordinates. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)// & + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)// & '' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NN*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',3*NN - write(unit=vtk(f)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + trim(str(.true.,vtk(rf)%ioffset))//'"/>' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NN*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',3*NN + write(unit=vtk(rf)%ua,iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1200,16 +1259,20 @@ contains implicit none integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - vtk(f)%indent = vtk(f)%indent - 2 - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + vtk(rf)%indent = vtk(rf)%indent - 2 + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1268,46 +1331,50 @@ contains integer(I1P), intent(IN):: cell_type(1:NC) !< VTK cell type. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//& + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//& '' - write(unit=vtk(f)%u,fmt=FI4P, iostat=E_IO)(connect(n1),n1=1,size(connect)) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FI4P, iostat=E_IO)(offset(n1),n1=1,NC) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt=FI1P, iostat=E_IO)(cell_type(n1),n1=1,NC) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt=FI4P, iostat=E_IO)(connect(n1),n1=1,size(connect)) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FI4P, iostat=E_IO)(offset(n1),n1=1,NC) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt=FI1P, iostat=E_IO)(cell_type(n1),n1=1,NC) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = size(connect)*BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',size(connect) - write(unit=vtk(f)%ua,iostat=E_IO)(connect(n1),n1=1,size(connect)) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC*BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',NC - write(unit=vtk(f)%ua,iostat=E_IO)(offset(n1),n1=1,NC) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC*BYI1P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I1',NC - write(unit=vtk(f)%ua,iostat=E_IO)(cell_type(n1),n1=1,NC) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = size(connect)*BYI4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',size(connect) + write(unit=vtk(rf)%ua,iostat=E_IO)(connect(n1),n1=1,size(connect)) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC*BYI4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',NC + write(unit=vtk(rf)%ua,iostat=E_IO)(offset(n1),n1=1,NC) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC*BYI1P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I1',NC + write(unit=vtk(rf)%ua,iostat=E_IO)(cell_type(n1),n1=1,NC) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1335,26 +1402,30 @@ contains character(*), intent(IN):: var_location !< Location of saving variables: CELL or NODE centered. character(*), intent(IN):: var_block_action !< Variables block action: OPEN or CLOSE block. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) select case(trim(Upper_Case(var_location))) case('CELL') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect case('NODE') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect endselect case(binary) @@ -1362,16 +1433,16 @@ contains case('CELL') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect case('NODE') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect endselect endselect @@ -1393,25 +1464,29 @@ contains real(R8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FR8P,iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FR8P,iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC_NN*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1428,25 +1503,29 @@ contains real(R4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FR4P,iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FR4P,iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC_NN*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1463,25 +1542,29 @@ contains integer(I8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FI8P,iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FI8P,iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYI8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I8',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(NC_NN*BYI8P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I8',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1498,25 +1581,29 @@ contains integer(I4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FI4P,iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FI4P,iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC_NN*BYI4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1533,25 +1620,29 @@ contains integer(I2P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FI2P, iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FI2P, iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYI2P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I2',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC_NN*BYI2P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I2',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1568,24 +1659,28 @@ contains integer(I1P), intent(IN):: var(1:NC_NN) !< Variable to be saved. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer=repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt=FI1P, iostat=E_IO)(var(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt=FI1P, iostat=E_IO)(var(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer=repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = NC_NN*BYI1P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I1',NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = NC_NN*BYI1P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I1',NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(var(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1604,25 +1699,29 @@ contains real(R8P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR8P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NC_NN*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1641,25 +1740,29 @@ contains real(R4P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FR4P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NC_NN*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1678,25 +1781,29 @@ contains integer(I8P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FI8P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FI8P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYI8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I8',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(3*NC_NN*BYI8P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I8',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1715,25 +1822,29 @@ contains integer(I4P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FI4P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FI4P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NC_NN*BYI4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1752,25 +1863,29 @@ contains integer(I2P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FI2P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FI2P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYI2P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I2',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = 3*NC_NN*BYI2P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I2',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1789,25 +1904,29 @@ contains integer(I1P), intent(IN):: varZ(1:NC_NN) !< Z component. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer=repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - write(unit=vtk(f)%u,fmt='(3('//FI1P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(3('//FI1P//',1X))',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer=repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = 3*NC_NN*BYI1P - call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I1',3*NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + vtk(rf)%N_Byte = 3*NC_NN*BYI1P + call vtk(rf)%byte_update(N_Byte = 3*NC_NN*BYI1P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I1',3*NC_NN + write(unit=vtk(rf)%ua,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1825,28 +1944,32 @@ contains real(R8P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FR8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FR8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYR8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R8',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = N_COL*NC_NN*BYR8P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R8',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -1865,28 +1988,32 @@ contains real(R4P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FR4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FR4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYR4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'R4',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = N_COL*NC_NN*BYR4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'R4',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -1905,28 +2032,32 @@ contains integer(I8P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FI8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FI8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYI8P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I8',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = int(N_COL*NC_NN*BYI8P,I4P)) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I8',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -1945,28 +2076,32 @@ contains integer(I4P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FI4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FI4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYI4P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I4',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = N_COL*NC_NN*BYI4P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I4',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -1985,28 +2120,32 @@ contains integer(I2P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FI2P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FI2P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYI2P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I2',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = N_COL*NC_NN*BYI2P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I2',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -2025,28 +2164,32 @@ contains integer(I1P), intent(IN):: var(1:,1:) !< Components. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. integer(I4P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) do n1=1,NC_NN - write(unit=vtk(f)%u,fmt=FI1P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) + write(unit=vtk(rf)%u,fmt=FI1P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case(binary) - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - vtk(f)%N_Byte = N_COL*NC_NN*BYI1P ; call ioffset_update(vtk(f)%N_Byte) - write(unit=vtk(f)%ua,iostat=E_IO)vtk(f)%N_Byte,'I1',N_COL*NC_NN + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call vtk(rf)%byte_update(N_Byte = N_COL*NC_NN*BYI1P) + write(unit=vtk(rf)%ua,iostat=E_IO)vtk(rf)%N_Byte,'I1',N_COL*NC_NN do n1=1,NC_NN - write(unit=vtk(f)%ua,iostat=E_IO)var(n1,:) + write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo endselect return @@ -2073,6 +2216,7 @@ contains integer(I4P), allocatable:: v_I4(:) !< I4 vector for IO in AppendData. integer(I2P), allocatable:: v_I2(:) !< I2 vector for IO in AppendData. integer(I1P), allocatable:: v_I1(:) !< I1 vector for IO in AppendData. + integer(I4P):: rf !< Real file index. #ifdef HUGE integer(I8P):: N_v !< Vector dimension. integer(I8P):: n1 !< Counter. @@ -2083,68 +2227,72 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'' + vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'' case(binary) - vtk(f)%indent = vtk(f)%indent - 2 - write(unit =vtk(f)%u, iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec - write(unit =vtk(f)%u, iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec - write(unit =vtk(f)%u, iostat=E_IO)'_' - endfile(unit=vtk(f)%ua,iostat=E_IO) - rewind(unit =vtk(f)%ua,iostat=E_IO) + vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit =vtk(rf)%u, iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + write(unit =vtk(rf)%u, iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + write(unit =vtk(rf)%u, iostat=E_IO)'_' + endfile(unit=vtk(rf)%ua,iostat=E_IO) + rewind(unit =vtk(rf)%ua,iostat=E_IO) do - read(unit=vtk(f)%ua,iostat=E_IO,end=100)vtk(f)%N_Byte,var_type,N_v + read(unit=vtk(rf)%ua,iostat=E_IO,end=100)vtk(rf)%N_Byte,var_type,N_v select case(var_type) case('R8') allocate(v_R8(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_R8(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_R8(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_R8(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_R8(n1),n1=1,N_v) deallocate(v_R8) case('R4') allocate(v_R4(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_R4(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_R4(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_R4(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_R4(n1),n1=1,N_v) deallocate(v_R4) case('I8') allocate(v_I8(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_I8(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_I8(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_I8(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I8(n1),n1=1,N_v) deallocate(v_I8) case('I4') allocate(v_I4(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_I4(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_I4(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_I4(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I4(n1),n1=1,N_v) deallocate(v_I4) case('I2') allocate(v_I2(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_I2(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_I2(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_I2(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I2(n1),n1=1,N_v) deallocate(v_I2) case('I1') allocate(v_I1(1:N_v)) - read(unit =vtk(f)%ua,iostat=E_IO)(v_I1(n1),n1=1,N_v) - write(unit=vtk(f)%u, iostat=E_IO)int(vtk(f)%N_Byte,I4P),(v_I1(n1),n1=1,N_v) + read(unit =vtk(rf)%ua,iostat=E_IO)(v_I1(n1),n1=1,N_v) + write(unit=vtk(rf)%u, iostat=E_IO)int(vtk(rf)%N_Byte,I4P),(v_I1(n1),n1=1,N_v) deallocate(v_I1) case default E_IO = 1 write (stderr,'(A)')' bad var_type = '//var_type - write (stderr,'(A)')' N_Byte = '//trim(str(n=vtk(f)%N_Byte))//' N_v = '//trim(str(n=N_v)) + write (stderr,'(A)')' N_Byte = '//trim(str(n=vtk(rf)%N_Byte))//' N_v = '//trim(str(n=N_v)) return endselect enddo 100 continue - write(unit=vtk(f)%u,iostat=E_IO)end_rec - write(unit=vtk(f)%u,iostat=E_IO)repeat(' ',vtk(f)%indent)//''//end_rec - write(unit=vtk(f)%u,iostat=E_IO)''//end_rec - close(unit=vtk(f)%ua,iostat=E_IO) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)''//end_rec + close(unit=vtk(rf)%ua,iostat=E_IO) endselect - close(unit=vtk(f)%u,iostat=E_IO) - call vtk_update(act='remove') - if (present(cf)) cf = f + close(unit=vtk(rf)%u,iostat=E_IO) + call vtk_update(act='remove',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf return !--------------------------------------------------------------------------------------------------------------------------------- endfunction VTK_END_XML @@ -2256,50 +2404,53 @@ contains character(*), intent(IN):: tp !< Type of geometry representation (Float32, Float64, ecc). integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- if (.not.ir_initialized) call IR_Init - call vtk_update(act='add') - if (present(cf)) cf = f - vtk(f)%topology = trim(mesh_topology) - open(unit=Get_Unit(vtk(f)%u),file=trim(filename),form='FORMATTED',access='SEQUENTIAL',action='WRITE',status='REPLACE',iostat=E_IO) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'' + call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf + vtk(rf)%topology = trim(mesh_topology) + open(unit=Get_Unit(vtk(rf)%u),file=trim(filename),& + form='FORMATTED',access='SEQUENTIAL',action='WRITE',status='REPLACE',iostat=E_IO) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'' if (endian==endianL) then - s_buffer = '' + s_buffer = '' else - s_buffer = '' + s_buffer = '' endif - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = 2 - select case(trim(vtk(f)%topology)) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = 2 + select case(trim(vtk(rf)%topology)) case('PRectilinearGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//' WholeExtent="'//& - trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & - trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//' WholeExtent="'//& + trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & trim(str(n=nz1))//' '//trim(str(n=nz2))//'" GhostLevel="#">' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case('PStructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//' WholeExtent="'//& - trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & - trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//' WholeExtent="'//& + trim(str(n=nx1))//' '//trim(str(n=nx2))//' '// & + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & trim(str(n=nz1))//' '//trim(str(n=nz2))//'" GhostLevel="#">' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' case('PUnstructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'<'//trim(vtk(f)%topology)//' GhostLevel="0">' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(f)%indent = vtk(f)%indent + 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//' GhostLevel="0">' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2321,19 +2472,23 @@ contains character(*), intent(IN):: source !< Source file name containing the piece data. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - select case (vtk(f)%topology) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case (vtk(rf)%topology) case('PRectilinearGrid','PStructuredGrid') - s_buffer = repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) case('PUnstructuredGrid') - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2349,24 +2504,28 @@ contains character(*), intent(IN):: var_location !< Location of saving variables: CELL or NODE centered. character(*), intent(IN):: var_block_action !< Variables block action: OPEN or CLOSE block. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif select case(trim(Upper_Case(var_location))) case('CELL') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect case('NODE') select case(trim(Upper_Case(var_block_action))) case('OPEN') - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' ; vtk(f)%indent = vtk(f)%indent + 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 case('CLOSE') - vtk(f)%indent = vtk(f)%indent - 2 ; write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' + vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' endselect endselect return @@ -2385,17 +2544,21 @@ contains character(*), intent(IN):: tp !< Type of data representation (Float32, Float64, ecc). integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif if (present(Nc)) then - s_buffer = repeat(' ',vtk(f)%indent)//'' else - s_buffer = repeat(' ',vtk(f)%indent)//'' + s_buffer = repeat(' ',vtk(rf)%indent)//'' endif - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) return !--------------------------------------------------------------------------------------------------------------------------------- endfunction PVTK_VAR_XML @@ -2408,16 +2571,21 @@ contains implicit none integer(I4P), intent(INOUT), optional:: cf !< Current file index (for concurrent files IO). integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - vtk(f)%indent = vtk(f)%indent - 2 - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(f)%indent)//'' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'' - close(unit=vtk(f)%u,iostat=E_IO) - call vtk_update(act='remove') - if (present(cf)) cf = f + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + vtk(rf)%indent = vtk(rf)%indent - 2 + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'' + close(unit=vtk(rf)%u,iostat=E_IO) + call vtk_update(act='remove',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf return !--------------------------------------------------------------------------------------------------------------------------------- endfunction PVTK_END_XML @@ -2439,31 +2607,34 @@ contains character(*), intent(IN):: title !< Title. character(*), intent(IN):: mesh_topology !< Mesh topology. integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- if (.not.ir_initialized) call IR_Init - call vtk_update(act='add') - if (present(cf)) cf = f - vtk(f)%topology = trim(mesh_topology) + call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf + vtk(rf)%topology = trim(mesh_topology) select case(trim(Upper_Case(output_format))) case('ASCII') - vtk(f)%f = ascii - open(unit=Get_Unit(vtk(f)%u),file=trim(filename),form='FORMATTED',& + vtk(rf)%f = ascii + open(unit=Get_Unit(vtk(rf)%u),file=trim(filename),form='FORMATTED',& access='SEQUENTIAL',action='WRITE',status='REPLACE',iostat=E_IO) ! writing header of file - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'# vtk DataFile Version 3.0' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(title) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)trim(Upper_Case(output_format)) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'DATASET '//trim(vtk(f)%topology) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'# vtk DataFile Version 3.0' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(title) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(Upper_Case(output_format)) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'DATASET '//trim(vtk(rf)%topology) case('BINARY') - vtk(f)%f = binary - open(unit=Get_Unit(vtk(f)%u),file=trim(filename),form='UNFORMATTED',access='STREAM',action='WRITE',status='REPLACE',iostat=E_IO) + vtk(rf)%f = binary + open(unit=Get_Unit(vtk(rf)%u),file=trim(filename),& + form='UNFORMATTED',access='STREAM',action='WRITE',status='REPLACE',iostat=E_IO) ! writing header of file - write(unit=vtk(f)%u,iostat=E_IO)'# vtk DataFile Version 3.0'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)trim(title)//end_rec - write(unit=vtk(f)%u,iostat=E_IO)trim(Upper_Case(output_format))//end_rec - write(unit=vtk(f)%u,iostat=E_IO)'DATASET '//trim(vtk(f)%topology)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'# vtk DataFile Version 3.0'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(title)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(Upper_Case(output_format))//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'DATASET '//trim(vtk(rf)%topology)//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2473,35 +2644,41 @@ contains !> @{ !> Function for saving mesh with \b STRUCTURED_POINTS topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRP_R8(Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) + function VTK_GEO_STRP_R8(cf,Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - real(R8P), intent(IN):: X0 !< X coordinate of origin. - real(R8P), intent(IN):: Y0 !< Y coordinate of origin. - real(R8P), intent(IN):: Z0 !< Z coordinate of origin. - real(R8P), intent(IN):: Dx !< Space step in x direction. - real(R8P), intent(IN):: Dy !< Space step in y direction. - real(R8P), intent(IN):: Dz !< Space step in z direction. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + real(R8P), intent(IN):: X0 !< X coordinate of origin. + real(R8P), intent(IN):: Y0 !< Y coordinate of origin. + real(R8P), intent(IN):: Z0 !< Z coordinate of origin. + real(R8P), intent(IN):: Dx !< Space step in x direction. + real(R8P), intent(IN):: Dy !< Space step in y direction. + real(R8P), intent(IN):: Dz !< Space step in z direction. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,3'//FR8P//')', iostat=E_IO)'ORIGIN ',X0,Y0,Z0 - write(unit=vtk(f)%u,fmt='(A,3'//FR8P//')', iostat=E_IO)'SPACING ',Dx,Dy,Dz + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')',iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,3'//FR8P//')',iostat=E_IO)'ORIGIN ',X0,Y0,Z0 + write(unit=vtk(rf)%u,fmt='(A,3'//FR8P//')',iostat=E_IO)'SPACING ',Dx,Dy,Dz case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,3'//FR8P//')', iostat=E_IO)'ORIGIN ',X0,Y0,Z0 - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,3'//FR8P//')', iostat=E_IO)'SPACING ',Dx,Dy,Dz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FI4P//')',iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FR8P//')',iostat=E_IO)'ORIGIN ',X0,Y0,Z0 + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FR8P//')',iostat=E_IO)'SPACING ',Dx,Dy,Dz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2509,35 +2686,41 @@ contains !> Function for saving mesh with \b STRUCTURED_POINTS topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRP_R4(Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) + function VTK_GEO_STRP_R4(cf,Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - real(R4P), intent(IN):: X0 !< X coordinate of origin. - real(R4P), intent(IN):: Y0 !< Y coordinate of origin. - real(R4P), intent(IN):: Z0 !< Z coordinate of origin. - real(R4P), intent(IN):: Dx !< Space step in x direction. - real(R4P), intent(IN):: Dy !< Space step in y direction. - real(R4P), intent(IN):: Dz !< Space step in z direction. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + real(R4P), intent(IN):: X0 !< X coordinate of origin. + real(R4P), intent(IN):: Y0 !< Y coordinate of origin. + real(R4P), intent(IN):: Z0 !< Z coordinate of origin. + real(R4P), intent(IN):: Dx !< Space step in x direction. + real(R4P), intent(IN):: Dy !< Space step in y direction. + real(R4P), intent(IN):: Dz !< Space step in z direction. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,3'//FR4P//')', iostat=E_IO)'ORIGIN ',X0,Y0,Z0 - write(unit=vtk(f)%u,fmt='(A,3'//FR4P//')', iostat=E_IO)'SPACING ',Dx,Dy,Dz + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')',iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,3'//FR4P//')',iostat=E_IO)'ORIGIN ',X0,Y0,Z0 + write(unit=vtk(rf)%u,fmt='(A,3'//FR4P//')',iostat=E_IO)'SPACING ',Dx,Dy,Dz case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,3'//FR4P//')', iostat=E_IO)'ORIGIN ',X0,Y0,Z0 - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,3'//FR4P//')', iostat=E_IO)'SPACING ',Dx,Dy,Dz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FI4P//')',iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FR4P//')',iostat=E_IO)'ORIGIN ',X0,Y0,Z0 + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,3'//FR4P//')',iostat=E_IO)'SPACING ',Dx,Dy,Dz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2545,34 +2728,40 @@ contains !> Function for saving mesh with \b STRUCTURED_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRG_R8(Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) + function VTK_GEO_STRG_R8(cf,Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - integer(I4P), intent(IN):: NN !< Number of all nodes. - real(R8P), intent(IN):: X(1:NN) !< X coordinates. - real(R8P), intent(IN):: Y(1:NN) !< Y coordinates. - real(R8P), intent(IN):: Z(1:NN) !< Z coordinates. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + integer(I4P), intent(IN):: NN !< Number of all nodes. + real(R8P), intent(IN):: X(1:NN) !< X coordinates. + real(R8P), intent(IN):: Y(1:NN) !< Y coordinates. + real(R8P), intent(IN):: Z(1:NN) !< Z coordinates. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' - write(unit=vtk(f)%u,fmt='(3'//FR8P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' + write(unit=vtk(rf)%u,fmt='(3'//FR8P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2580,34 +2769,40 @@ contains !> Function for saving mesh with \b STRUCTURED_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRG_R4(Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) + function VTK_GEO_STRG_R4(cf,Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - integer(I4P), intent(IN):: NN !< Number of all nodes. - real(R4P), intent(IN):: X(1:NN) !< X coordinates. - real(R4P), intent(IN):: Y(1:NN) !< Y coordinates. - real(R4P), intent(IN):: Z(1:NN) !< Z coordinates. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + integer(I4P), intent(IN):: NN !< Number of all nodes. + real(R4P), intent(IN):: X(1:NN) !< X coordinates. + real(R4P), intent(IN):: Y(1:NN) !< Y coordinates. + real(R4P), intent(IN):: Z(1:NN) !< Z coordinates. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' - write(unit=vtk(f)%u,fmt='(3'//FR4P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' + write(unit=vtk(rf)%u,fmt='(3'//FR4P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2615,45 +2810,51 @@ contains !> Function for saving mesh with \b RECTILINEAR_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_RECT_R8(Nx,Ny,Nz,X,Y,Z) result(E_IO) + function VTK_GEO_RECT_R8(cf,Nx,Ny,Nz,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - real(R8P), intent(IN):: X(1:Nx) !< X coordinates. - real(R8P), intent(IN):: Y(1:Ny) !< Y coordinates. - real(R8P), intent(IN):: Z(1:Nz) !< Z coordinates. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + real(R8P), intent(IN):: X(1:Nx) !< X coordinates. + real(R8P), intent(IN):: Y(1:Ny) !< Y coordinates. + real(R8P), intent(IN):: Z(1:Nz) !< Z coordinates. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' double' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(X(n1),n1=1,Nx) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' double' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(Y(n1),n1=1,Ny) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' double' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)(Z(n1),n1=1,Nz) + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' double' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(X(n1),n1=1,Nx) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' double' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(Y(n1),n1=1,Ny) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' double' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)(Z(n1),n1=1,Nz) case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' double' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),n1=1,Nx) - write(unit=vtk(f)%u, iostat=E_IO)end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' double' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(Y(n1),n1=1,Ny) - write(unit=vtk(f)%u, iostat=E_IO)end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' double' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(Z(n1),n1=1,Nz) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' double' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),n1=1,Nx) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' double' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(Y(n1),n1=1,Ny) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' double' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(Z(n1),n1=1,Nz) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2661,45 +2862,51 @@ contains !> Function for saving mesh with \b RECTILINEAR_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_RECT_R4(Nx,Ny,Nz,X,Y,Z) result(E_IO) + function VTK_GEO_RECT_R4(cf,Nx,Ny,Nz,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. - integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. - integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. - real(R4P), intent(IN):: X(1:Nx) !< X coordinates. - real(R4P), intent(IN):: Y(1:Ny) !< Y coordinates. - real(R4P), intent(IN):: Z(1:Nz) !< Z coordinates. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: Nx !< Number of nodes in x direction. + integer(I4P), intent(IN):: Ny !< Number of nodes in y direction. + integer(I4P), intent(IN):: Nz !< Number of nodes in z direction. + real(R4P), intent(IN):: X(1:Nx) !< X coordinates. + real(R4P), intent(IN):: Y(1:Ny) !< Y coordinates. + real(R4P), intent(IN):: Z(1:Nz) !< Z coordinates. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' float' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(X(n1),n1=1,Nx) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' float' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(Y(n1),n1=1,Ny) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' float' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)(Z(n1),n1=1,Nz) + write(unit=vtk(rf)%u,fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' float' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(X(n1),n1=1,Nx) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' float' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(Y(n1),n1=1,Ny) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' float' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)(Z(n1),n1=1,Nz) case(binary) - write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' float' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),n1=1,Nx) - write(unit=vtk(f)%u, iostat=E_IO)end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' float' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(Y(n1),n1=1,Ny) - write(unit=vtk(f)%u, iostat=E_IO)end_rec - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' float' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(Z(n1),n1=1,Nz) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,3'//FI4P//')', iostat=E_IO)'DIMENSIONS ',Nx,Ny,Nz + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'X_COORDINATES ',Nx,' float' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),n1=1,Nx) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Y_COORDINATES ',Ny,' float' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(Y(n1),n1=1,Ny) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'Z_COORDINATES ',Nz,' float' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(Z(n1),n1=1,Nz) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2707,28 +2914,34 @@ contains !> Function for saving mesh with \b UNSTRUCTURED_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_UNST_R8(NN,X,Y,Z) result(E_IO) + function VTK_GEO_UNST_R8(cf,NN,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NN !< Number of nodes. - real(R8P), intent(IN):: X(1:NN) !< X coordinates of all nodes. - real(R8P), intent(IN):: Y(1:NN) !< Y coordinates of all nodes. - real(R8P), intent(IN):: Z(1:NN) !< Z coordinates of all nodes. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NN !< Number of nodes. + real(R8P), intent(IN):: X(1:NN) !< X coordinates of all nodes. + real(R8P), intent(IN):: Y(1:NN) !< Y coordinates of all nodes. + real(R8P), intent(IN):: Z(1:NN) !< Z coordinates of all nodes. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' - write(unit=vtk(f)%u,fmt='(3'//FR8P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' + write(unit=vtk(rf)%u,fmt='(3'//FR8P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) case(binary) - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' double' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2736,28 +2949,34 @@ contains !> Function for saving mesh with \b UNSTRUCTURED_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_UNST_R4(NN,X,Y,Z) result(E_IO) + function VTK_GEO_UNST_R4(cf,NN,X,Y,Z) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NN !< number of nodes. - real(R4P), intent(IN):: X(1:NN) !< x coordinates of all nodes. - real(R4P), intent(IN):: Y(1:NN) !< y coordinates of all nodes. - real(R4P), intent(IN):: Z(1:NN) !< z coordinates of all nodes. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< buffer string. - integer(I4P):: n1 !< counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NN !< number of nodes. + real(R4P), intent(IN):: X(1:NN) !< x coordinates of all nodes. + real(R4P), intent(IN):: Y(1:NN) !< y coordinates of all nodes. + real(R4P), intent(IN):: Z(1:NN) !< z coordinates of all nodes. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< buffer string. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' - write(unit=vtk(f)%u,fmt='(3'//FR4P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' + write(unit=vtk(rf)%u,fmt='(3'//FR4P//')', iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) case(binary) - write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//',A)',iostat=E_IO)'POINTS ',NN,' float' + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)(X(n1),Y(n1),Z(n1),n1=1,NN) + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2803,34 +3022,40 @@ contains !> cell_type(2) = 14 pyramid type of \f$2^\circ\f$ cell \n !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function VTK_CON(NC,connect,cell_type) result(E_IO) + function VTK_CON(cf,NC,connect,cell_type) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC !< Number of cells. - integer(I4P), intent(IN):: connect(:) !< Mesh connectivity. - integer(I4P), intent(IN):: cell_type(1:NC) !< VTK cell type. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I4P):: ncon !< Dimension of connectivity vector. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC !< Number of cells. + integer(I4P), intent(IN):: connect(:) !< Mesh connectivity. + integer(I4P), intent(IN):: cell_type(1:NC) !< VTK cell type. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: ncon !< Dimension of connectivity vector. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif ncon = size(connect,1) - select case(vtk(f)%f) + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,2'//FI4P//')',iostat=E_IO)'CELLS ',NC,ncon - write(unit=vtk(f)%u,fmt=FI4P, iostat=E_IO)connect - write(unit=vtk(f)%u,fmt='(A,'//FI4P//')', iostat=E_IO)'CELL_TYPES ',NC - write(unit=vtk(f)%u,fmt=FI4P, iostat=E_IO)cell_type + write(unit=vtk(rf)%u,fmt='(A,2'//FI4P//')',iostat=E_IO)'CELLS ',NC,ncon + write(unit=vtk(rf)%u,fmt=FI4P, iostat=E_IO)connect + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//')', iostat=E_IO)'CELL_TYPES ',NC + write(unit=vtk(rf)%u,fmt=FI4P, iostat=E_IO)cell_type case(binary) - write(s_buffer, fmt='(A,2'//FI4P//')',iostat=E_IO)'CELLS ',NC,ncon - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)connect - write(unit=vtk(f)%u, iostat=E_IO)end_rec - write(s_buffer, fmt='(A,'//FI4P//')', iostat=E_IO)'CELL_TYPES ',NC - write(unit=vtk(f)%u, iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u, iostat=E_IO)cell_type - write(unit=vtk(f)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,2'//FI4P//')',iostat=E_IO)'CELLS ',NC,ncon + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)connect + write(unit=vtk(rf)%u, iostat=E_IO)end_rec + write(s_buffer, fmt='(A,'//FI4P//')', iostat=E_IO)'CELL_TYPES ',NC + write(unit=vtk(rf)%u, iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u, iostat=E_IO)cell_type + write(unit=vtk(rf)%u, iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2851,32 +3076,38 @@ contains !> ... @endcode !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function VTK_DAT(NC_NN,var_location) result(E_IO) + function VTK_DAT(cf,NC_NN,var_location) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes of field. - character(*), intent(IN):: var_location !< Location of saving variables: cell for cell-centered, node for node-centered. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes of field. + character(*), intent(IN):: var_location !< Location of saving variables: cell for cell-centered, node for node-centered. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) select case(trim(Upper_Case(var_location))) case('CELL') - write(unit=vtk(f)%u,fmt='(A,'//FI4P//')',iostat=E_IO)'CELL_DATA ',NC_NN + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//')',iostat=E_IO)'CELL_DATA ',NC_NN case('NODE') - write(unit=vtk(f)%u,fmt='(A,'//FI4P//')',iostat=E_IO)'POINT_DATA ',NC_NN + write(unit=vtk(rf)%u,fmt='(A,'//FI4P//')',iostat=E_IO)'POINT_DATA ',NC_NN endselect case(binary) select case(trim(Upper_Case(var_location))) case('CELL') write(s_buffer,fmt='(A,'//FI4P//')',iostat=E_IO)'CELL_DATA ',NC_NN - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec case('NODE') write(s_buffer,fmt='(A,'//FI4P//')',iostat=E_IO)'POINT_DATA ',NC_NN - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec endselect endselect return @@ -2887,26 +3118,32 @@ contains !> @{ !> Function for saving field of scalar variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_R8(NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_R8(cf,NC_NN,varname,var) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - real(R8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + real(R8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' double 1' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' - write(unit=vtk(f)%u,fmt=FR8P, iostat=E_IO)var + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' double 1' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' + write(unit=vtk(rf)%u,fmt=FR8P, iostat=E_IO)var case(binary) - write(unit=vtk(f)%u,iostat=E_IO)'SCALARS '//trim(varname)//' double 1'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)var - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'SCALARS '//trim(varname)//' double 1'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)var + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2914,26 +3151,32 @@ contains !> Function for saving field of scalar variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_R4(NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_R4(cf,NC_NN,varname,var) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - real(R4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + real(R4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' float 1' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' - write(unit=vtk(f)%u,fmt=FR4P, iostat=E_IO)var + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' float 1' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' + write(unit=vtk(rf)%u,fmt=FR4P, iostat=E_IO)var case(binary) - write(unit=vtk(f)%u,iostat=E_IO)'SCALARS '//trim(varname)//' float 1'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)var - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'SCALARS '//trim(varname)//' float 1'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)var + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2941,26 +3184,32 @@ contains !> Function for saving field of scalar variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_I4(NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_I4(cf,NC_NN,varname,var) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - integer(I4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + integer(I4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' int 1' - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' - write(unit=vtk(f)%u,fmt=FI4P, iostat=E_IO)var + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'SCALARS '//trim(varname)//' int 1' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'LOOKUP_TABLE default' + write(unit=vtk(rf)%u,fmt=FI4P, iostat=E_IO)var case(binary) - write(unit=vtk(f)%u,iostat=E_IO)'SCALARS '//trim(varname)//' int 1'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)var - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'SCALARS '//trim(varname)//' int 1'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'LOOKUP_TABLE default'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)var + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2968,38 +3217,44 @@ contains !> Function for saving field of vectorial variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_R8(vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_R8(cf,vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - character(*), intent(IN):: vec_type !< Vector type: vect = generic vector , norm = normal vector. - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - real(R8P), intent(IN):: varX(1:NC_NN) !< X component of vector. - real(R8P), intent(IN):: varY(1:NC_NN) !< Y component of vector. - real(R8P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - integer(I8P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + character(*), intent(IN):: vec_type !< Vector type: vect = generic vector , norm = normal vector. + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + real(R8P), intent(IN):: varX(1:NC_NN) !< X component of vector. + real(R8P), intent(IN):: varY(1:NC_NN) !< Y component of vector. + real(R8P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. + integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) select case(Upper_Case(trim(vec_type))) case('VECT') - write(unit=vtk(f)%u,fmt='(A)', iostat=E_IO)'VECTORS '//trim(varname)//' double' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'VECTORS '//trim(varname)//' double' case('NORM') - write(unit=vtk(f)%u,fmt='(A)', iostat=E_IO)'NORMALS '//trim(varname)//' double' + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'NORMALS '//trim(varname)//' double' endselect - write(unit=vtk(f)%u,fmt='(3'//FR8P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(3'//FR8P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) case(binary) select case(Upper_Case(trim(vec_type))) case('VECT') - write(unit=vtk(f)%u,iostat=E_IO)'VECTORS '//trim(varname)//' double'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'VECTORS '//trim(varname)//' double'//end_rec case('NORM') - write(unit=vtk(f)%u,iostat=E_IO)'NORMALS '//trim(varname)//' double'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'NORMALS '//trim(varname)//' double'//end_rec endselect - write(unit=vtk(f)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -3007,38 +3262,44 @@ contains !> Function for saving field of vectorial variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_R4(vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_R4(cf,vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - character(*), intent(IN):: vec_type !< Vector type: vect = generic vector , norm = normal vector. - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - real(R4P), intent(IN):: varX(1:NC_NN) !< X component of vector. - real(R4P), intent(IN):: varY(1:NC_NN) !< Y component of vector. - real(R4P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - integer(I8P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + character(*), intent(IN):: vec_type !< Vector type: vect = generic vector , norm = normal vector. + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + real(R4P), intent(IN):: varX(1:NC_NN) !< X component of vector. + real(R4P), intent(IN):: varY(1:NC_NN) !< Y component of vector. + real(R4P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. + integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) select case(Upper_Case(trim(vec_type))) case('vect') - write(unit=vtk(f)%u,fmt='(A)', iostat=E_IO)'VECTORS '//trim(varname)//' float' + write(unit=vtk(rf)%u,fmt='(A)', iostat=E_IO)'VECTORS '//trim(varname)//' float' case('norm') - write(unit=vtk(f)%u,fmt='(A)', iostat=E_IO)'NORMALS '//trim(varname)//' float' + write(unit=vtk(rf)%u,fmt='(A)', iostat=E_IO)'NORMALS '//trim(varname)//' float' endselect - write(unit=vtk(f)%u,fmt='(3'//FR4P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(3'//FR4P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) case(binary) select case(Upper_Case(trim(vec_type))) case('vect') - write(unit=vtk(f)%u,iostat=E_IO)'VECTORS '//trim(varname)//' float'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'VECTORS '//trim(varname)//' float'//end_rec case('norm') - write(unit=vtk(f)%u,iostat=E_IO)'NORMALS '//trim(varname)//' float'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'NORMALS '//trim(varname)//' float'//end_rec endselect - write(unit=vtk(f)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -3046,27 +3307,33 @@ contains !> Function for saving field of vectorial variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_I4(NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_I4(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - character(*), intent(IN):: varname !< Variable name. - integer(I4P), intent(IN):: varX(1:NC_NN) !< X component of vector. - integer(I4P), intent(IN):: varY(1:NC_NN) !< Y component of vector. - integer(I4P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - integer(I8P):: n1 !< Counter. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + character(*), intent(IN):: varname !< Variable name. + integer(I4P), intent(IN):: varX(1:NC_NN) !< X component of vector. + integer(I4P), intent(IN):: varY(1:NC_NN) !< Y component of vector. + integer(I4P), intent(IN):: varZ(1:NC_NN) !< Z component of vector. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. + integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A)',iostat=E_IO)'VECTORS '//trim(varname)//' int' - write(unit=vtk(f)%u,fmt='(3'//FI4P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'VECTORS '//trim(varname)//' int' + write(unit=vtk(rf)%u,fmt='(3'//FI4P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) case(binary) - write(unit=vtk(f)%u,iostat=E_IO)'VECTORS '//trim(varname)//' int'//end_rec - write(unit=vtk(f)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)'VECTORS '//trim(varname)//' int'//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -3074,30 +3341,36 @@ contains !> Function for saving texture variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_TEXT_R8(NC_NN,dimm,varname,textCoo) result(E_IO) + function VTK_VAR_TEXT_R8(cf,NC_NN,dimm,varname,textCoo) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - integer(I4P), intent(IN):: dimm !< Texture dimensions. - character(*), intent(IN):: varname !< Variable name. - real(R8P), intent(IN):: textCoo(1:NC_NN,1:dimm) !< Texture. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I8P):: n1,n2 !< Counters. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + integer(I4P), intent(IN):: dimm !< Texture dimensions. + character(*), intent(IN):: varname !< Variable name. + real(R8P), intent(IN):: textCoo(1:NC_NN,1:dimm) !< Texture. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I8P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' double' + write(unit=vtk(rf)%u,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' double' write(s_buffer,fmt='(I1)',iostat=E_IO)dimm s_buffer='('//trim(s_buffer)//FR4P//')' - write(unit=vtk(f)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) case(binary) write(s_buffer,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' double' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u,iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -3105,34 +3378,40 @@ contains !> Function for saving texture variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_TEXT_R4(NC_NN,dimm,varname,textCoo) result(E_IO) + function VTK_VAR_TEXT_R4(cf,NC_NN,dimm,varname,textCoo) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- !! Function for saving texture variable (R4P). !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. - integer(I4P), intent(IN):: dimm !< Texture dimensions. - character(*), intent(IN):: varname !< Variable name. - real(R4P), intent(IN):: textCoo(1:NC_NN,1:dimm) !< Texture. - integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. - character(len=maxlen):: s_buffer !< Buffer string. - integer(I8P):: n1,n2 !< Counters. + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN):: NC_NN !< Number of nodes or cells. + integer(I4P), intent(IN):: dimm !< Texture dimensions. + character(*), intent(IN):: varname !< Variable name. + real(R4P), intent(IN):: textCoo(1:NC_NN,1:dimm) !< Texture. + integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: rf !< Real file index. + integer(I8P):: n1,n2 !< Counters. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - select case(vtk(f)%f) + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif + select case(vtk(rf)%f) case(ascii) - write(unit=vtk(f)%u,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' float' + write(unit=vtk(rf)%u,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' float' write(s_buffer,fmt='(I1)',iostat=E_IO)dimm s_buffer='('//trim(s_buffer)//FR4P//')' - write(unit=vtk(f)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) + write(unit=vtk(rf)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) case(binary) write(s_buffer,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' float' - write(unit=vtk(f)%u,iostat=E_IO)trim(s_buffer)//end_rec - write(unit=vtk(f)%u,iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) - write(unit=vtk(f)%u,iostat=E_IO)end_rec + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) + write(unit=vtk(rf)%u,iostat=E_IO)end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -3152,13 +3431,15 @@ contains implicit none integer(I4P), intent(INOUT), optional:: cf !< Current file index (for concurrent files IO). integer(I4P):: E_IO !< Input/Output inquiring flag: $0$ if IO is done, $> 0$ if IO is not done. + integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - if (present(cf)) f = cf - close(unit=vtk(f)%u,iostat=E_IO) - call vtk_update(act='remove') - if (present(cf)) cf = f + if (present(cf)) rf = cf + close(unit=vtk(rf)%u,iostat=E_IO) + call vtk_update(act='remove',cf=rf,Nvtk=Nvtk,vtk=vtk) + f = rf + if (present(cf)) cf = rf return !--------------------------------------------------------------------------------------------------------------------------------- endfunction VTK_END