diff --git a/code/libs.f90 b/code/libs.f90 index 17c79d8d1..b1831801e 100644 --- a/code/libs.f90 +++ b/code/libs.f90 @@ -27,6 +27,7 @@ #include "../lib/kdtree2.f90" #endif #include "../lib/IR_Precision.f90" +#include "../lib/Lib_Base64.f90" #include "../lib/Lib_VTK_IO.f90" module libs diff --git a/lib/IR_Precision.f90 b/lib/IR_Precision.f90 index e995ac898..eac3ef91d 100644 --- a/lib/IR_Precision.f90 +++ b/lib/IR_Precision.f90 @@ -71,7 +71,7 @@ public:: I1P, FI1P, DI1P, MinI1P, MaxI1P, BII1P, BYI1P public:: I_P, FI_P, DI_P, MinI_P, MaxI_P, BII_P, BYI_P public:: check_endian public:: bit_size -public:: str, strz, cton +public:: str, strz, cton, bstr, bcton public:: ir_initialized,IR_Init public:: IR_Print !----------------------------------------------------------------------------------------------------------------------------------- @@ -143,7 +143,7 @@ real(R4P), parameter:: MinR4P = -huge(1._R4P ), MaxR4P = huge(1._R4P ) !< Min real(R_P), parameter:: MinR_P = MinR8P, MaxR_P = MaxR8P !< Min and max values of kind=R_P variable. ! Real number of bits/bytes #ifdef r16p -integer(I1P):: BIR16P, BYR16P !< Number of bits/bytes of kind=R16P variable. +integer(I2P):: BIR16P, BYR16P !< Number of bits/bytes of kind=R16P variable. #endif integer(I1P):: BIR8P, BYR8P !< Number of bits/bytes of kind=R8P variable. integer(I1P):: BIR4P, BYR4P !< Number of bits/bytes of kind=R4P variable. @@ -156,11 +156,11 @@ real(R8P), parameter:: smallR8P = tiny(1._R8P ) !< Smallest representable valu real(R4P), parameter:: smallR4P = tiny(1._R4P ) !< Smallest representable value of kind=R4P variable. real(R_P), parameter:: smallR_P = smallR8P !< Smallest representable value of kind=R_P variable. ! Integer min and max values: -integer(I8P), parameter:: MinI8P = -huge(1_I8P)-1_I8P, MaxI8P = huge(1_I8P) !< Min and max values of kind=I8P variable. -integer(I4P), parameter:: MinI4P = -huge(1_I4P)-1_I4P, MaxI4P = huge(1_I4P) !< Min and max values of kind=I4P variable. -integer(I2P), parameter:: MinI2P = -huge(1_I2P)-1_I2P, MaxI2P = huge(1_I2P) !< Min and max values of kind=I2P variable. -integer(I1P), parameter:: MinI1P = -huge(1_I1P)-1_I1P, MaxI1P = huge(1_I1P) !< Min and max values of kind=I1P variable. -integer(I_P), parameter:: MinI_P = MinI4P, MaxI_P = MaxI4P !< Min and max values of kind=I_P variable. +integer(I8P), parameter:: MinI8P = -huge(1_I8P), MaxI8P = huge(1_I8P) !< Min and max values of kind=I8P variable. +integer(I4P), parameter:: MinI4P = -huge(1_I4P), MaxI4P = huge(1_I4P) !< Min and max values of kind=I4P variable. +integer(I2P), parameter:: MinI2P = -huge(1_I2P), MaxI2P = huge(1_I2P) !< Min and max values of kind=I2P variable. +integer(I1P), parameter:: MinI1P = -huge(1_I1P), MaxI1P = huge(1_I1P) !< Min and max values of kind=I1P variable. +integer(I_P), parameter:: MinI_P = MinI4P, MaxI_P = MaxI4P !< Min and max values of kind=I_P variable. ! Integer number of bits/bytes: integer(I8P), parameter:: BII8P = bit_size(MaxI8P), BYI8P = bit_size(MaxI8P)/8_I8P !< Number of bits/bytes of kind=I8P variable. integer(I4P), parameter:: BII4P = bit_size(MaxI4P), BYI4P = bit_size(MaxI4P)/8_I4P !< Number of bits/bytes of kind=I4P variable. @@ -206,14 +206,14 @@ endinterface interface str module procedure & #ifdef r16p - str_R16P,strf_R16P,& + strf_R16P,str_R16P,& #endif - str_R8P,strf_R8P, & - str_R4P,strf_R4P, & - str_I8P,strf_I8P, & - str_I4P,strf_I4P, & - str_I2P,strf_I2P, & - str_I1P,strf_I1P + strf_R8P ,str_R8P, & + strf_R4P ,str_R4P, & + strf_I8P ,str_I8P, & + strf_I4P ,str_I4P, & + strf_I2P ,str_I2P, & + strf_I1P ,str_I1P endinterface !> @brief Function for converting number, integer, to string, prefixing with the right number of zeros (number to string type !> casting with zero padding); @@ -243,6 +243,38 @@ interface cton ctoi_I2P, & ctoi_I1P endinterface +!> @brief Function for converting number, real and integer, to bit-string (number to bit-string type casting); +!> number, intent(\b IN):: \em n input number; +!> string, intent(\b OUT):: \em bstr output bit-string. +!> @ingroup IR_PrecisionInterface +interface bstr + module procedure & +#ifdef r16p + bstr_R16P,& +#endif + bstr_R8P, & + bstr_R4P, & + bstr_I8P, & + bstr_I4P, & + bstr_I2P, & + bstr_I1P +endinterface +!> @brief Function for converting bit-string to number, real or initeger, (bit-string to number type casting); +!> string, intent(\b IN):: \em bstr input bit-string; +!> number, intent(\b OUT):: \em n output number. +!> @ingroup IR_PrecisionInterface +interface bcton + module procedure & +#ifdef r16p + bctor_R16P, & +#endif + bctor_R8P, & + bctor_R4P, & + bctoi_I8P, & + bctoi_I4P, & + bctoi_I2P, & + bctoi_I1P +endinterface !----------------------------------------------------------------------------------------------------------------------------------- contains !> @ingroup IR_PrecisionPublicProcedure @@ -289,12 +321,12 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- implicit none real(R16P), intent(IN):: i !< Real variable of which number of bits must be computed. - integer(I1P):: bits !< Number of bits of i. + integer(I2P):: bits !< Number of bits of i. integer(I1P):: mold(1) !< "Molding" dummy variable for bits counting. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - bits = size(transfer(i,mold))*8_I1P + bits = size(transfer(i,mold))*8_I2P return !--------------------------------------------------------------------------------------------------------------------------------- endfunction bit_size_R16P @@ -782,6 +814,203 @@ contains return !--------------------------------------------------------------------------------------------------------------------------------- endfunction ctoi_I1P + +#ifdef r16p + !> @brief Function for converting real to string of bits. This function achieves casting of real to bit-string. + !> @note It is assumed that R16P is represented by means of 128 bits, but this is not ensured in all architectures. + elemental function bstr_R16P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: n !< Real to be converted. + character(128):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B128.128)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_R16P +#endif + + !> @brief Function for converting real to string of bits. This function achieves casting of real to bit-string. + !> @note It is assumed that R8P is represented by means of 64 bits, but this is not ensured in all architectures. + elemental function bstr_R8P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: n !< Real to be converted. + character(64):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B64.64)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_R8P + + !> @brief Function for converting real to string of bits. This function achieves casting of real to bit-string. + !> @note It is assumed that R4P is represented by means of 32 bits, but this is not ensured in all architectures. + elemental function bstr_R4P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: n !< Real to be converted. + character(32):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B32.32)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_R4P + + !> @brief Function for converting integer to string of bits. This function achieves casting of integer to bit-string. + !> @note It is assumed that I8P is represented by means of 64 bits, but this is not ensured in all architectures. + elemental function bstr_I8P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: n !< Real to be converted. + character(64):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B64.64)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_I8P + + !> @brief Function for converting integer to string of bits. This function achieves casting of integer to bit-string. + !> @note It is assumed that I4P is represented by means of 32 bits, but this is not ensured in all architectures. + elemental function bstr_I4P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: n !< Real to be converted. + character(32):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B32.32)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_I4P + + !> @brief Function for converting integer to string of bits. This function achieves casting of integer to bit-string. + !> @note It is assumed that I2P is represented by means of 16 bits, but this is not ensured in all architectures. + elemental function bstr_I2P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: n !< Real to be converted. + character(16):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B16.16)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_I2P + + !> @brief Function for converting integer to string of bits. This function achieves casting of integer to bit-string. + !> @note It is assumed that I1P is represented by means of 8 bits, but this is not ensured in all architectures. + elemental function bstr_I1P(n) result(bstr) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: n !< Real to be converted. + character(8):: bstr !< Returned bit-string containing input number. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + write(bstr,'(B8.8)')n ! Casting of n to bit-string. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bstr_I1P + + !> @brief Function for converting bit-string to real. This function achieves casting of bit-string to real. + elemental function bctor_R8P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + real(R8P), intent(IN):: knd !< Number kind. + real(R8P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctor_R8P + + !> @brief Function for converting bit-string to real. This function achieves casting of bit-string to real. + elemental function bctor_R4P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + real(R4P), intent(IN):: knd !< Number kind. + real(R4P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctor_R4P + + !> @brief Function for converting bit-string to integer. This function achieves casting of bit-string to integer. + elemental function bctoi_I8P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + integer(I8P), intent(IN):: knd !< Number kind. + integer(I8P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctoi_I8P + + !> @brief Function for converting bit-string to integer. This function achieves casting of bit-string to integer. + elemental function bctoi_I4P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + integer(I4P), intent(IN):: knd !< Number kind. + integer(I4P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctoi_I4P + + !> @brief Function for converting bit-string to integer. This function achieves casting of bit-string to integer. + elemental function bctoi_I2P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + integer(I2P), intent(IN):: knd !< Number kind. + integer(I2P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctoi_I2P + + !> @brief Function for converting bit-string to integer. This function achieves casting of bit-string to integer. + elemental function bctoi_I1P(bstr,knd) result(n) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + character(*), intent(IN):: bstr !< String containing input number. + integer(I1P), intent(IN):: knd !< Number kind. + integer(I1P):: n !< Number returned. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + read(bstr,'(B'//trim(str(.true.,bit_size(knd)))//'.'//trim(str(.true.,bit_size(knd)))//')')n ! Casting of bstr to n. + return + !--------------------------------------------------------------------------------------------------------------------------------- + endfunction bctoi_I1P !> @} !> Subroutine for initilizing module's variables that are not initialized into the definition specification. diff --git a/lib/Lib_Base64.f90 b/lib/Lib_Base64.f90 new file mode 100644 index 000000000..515547619 --- /dev/null +++ b/lib/Lib_Base64.f90 @@ -0,0 +1,867 @@ +!> @ingroup Library +!> @{ +!> @defgroup Lib_Base64Library Lib_Base64 +!> @} + +!> @ingroup Interface +!> @{ +!> @defgroup Lib_Base64Interface Lib_Base64 +!> @} + +!> @ingroup PublicProcedure +!> @{ +!> @defgroup Lib_Base64PublicProcedure Lib_Base64 +!> @} + +!> @ingroup PrivateProcedure +!> @{ +!> @defgroup Lib_Base64PrivateProcedure Lib_Base64 +!> @} + +!> @ingroup GlobalVarPar +!> @{ +!> @defgroup Lib_Base64GlobalVarPar Lib_Base64 +!> @} + +!> @ingroup PrivateVarPar +!> @{ +!> @defgroup Lib_Base64PrivateVarPar Lib_Base64 +!> @} + +!> This module contains base64 encoding/decoding procedures. +!> @todo \b Decoding: Implement decoding functions. +!> @todo \b DocComplete: Complete the documentation. +!> @ingroup Lib_Base64Library +module Lib_Base64 +!----------------------------------------------------------------------------------------------------------------------------------- +USE IR_Precision ! Integers and reals precision definition. +!----------------------------------------------------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------------------------------------------------- +implicit none +private +public:: b64_encode +!public:: b64_decode +public:: pack_data +!----------------------------------------------------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------------------------------------------------- +!> @ingroup Lib_Base64GlobalVarPar +!> @{ +!> @} +!> @ingroup Lib_Base64PrivateVarPar +!> @{ +character(64):: base64="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" !< Base64 alphabet. +!> @} +!----------------------------------------------------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------------------------------------------------- +!> @brief Subroutine for encoding numbers (integer and real) to base64. +!> @ingroup Lib_Base64Interface +interface b64_encode + module procedure b64_encode_R8_a, & + b64_encode_R4_a, & + b64_encode_I8_a, & + b64_encode_I4_a, & + b64_encode_I2_a, & + b64_encode_I1_a +endinterface +!!> @brief Subroutine for decoding numbers (integer and real) from base64. +!!> @ingroup Lib_Base64Interface +!interface b64_decode +! module procedure b64_decode_R8_a, & +! b64_decode_R4_a, & +! b64_decode_I8_a, & +! b64_decode_I4_a, & +! b64_decode_I2_a, & +! b64_decode_I1_a +!endinterface +!> @brief Subroutine for packing different kinds of data into single I1P array. This is useful for encoding different kinds +!> variables into a single stream of bits. +!> @ingroup Lib_Base64Interface +interface pack_data + module procedure pack_data_R8_R4,pack_data_R8_I8,pack_data_R8_I4,pack_data_R8_I2,pack_data_R8_I1, & + pack_data_R4_R8,pack_data_R4_I8,pack_data_R4_I4,pack_data_R4_I2,pack_data_R4_I1, & + pack_data_I8_R8,pack_data_I8_R4,pack_data_I8_I4,pack_data_I8_I2,pack_data_I8_I1, & + pack_data_I4_R8,pack_data_I4_R4,pack_data_I4_I8,pack_data_I4_I2,pack_data_I4_I1, & + pack_data_I2_R8,pack_data_I2_R4,pack_data_I2_I8,pack_data_I2_I4,pack_data_I2_I1, & + pack_data_I1_R8,pack_data_I1_R4,pack_data_I1_I8,pack_data_I1_I4,pack_data_I1_I2 +endinterface +!----------------------------------------------------------------------------------------------------------------------------------- +contains + !> @ingroup Lib_Base64PrivateProcedure + !> @{ + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R8_R4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: a1(1:) !< Firs data stream. + real(R4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R8_R4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R8_I8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: a1(1:) !< First data stream. + integer(I8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R8_I8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R8_I4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: a1(1:) !< First data stream. + integer(I4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R8_I4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R8_I2(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: a1(1:) !< First data stream. + integer(I2P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R8_I2 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R8_I1(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R8P), intent(IN):: a1(1:) !< First data stream. + integer(I1P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R8_I1 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R4_R8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: a1(1:) !< Firs data stream. + real(R8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R4_R8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R4_I8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: a1(1:) !< First data stream. + integer(I8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R4_I8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R4_I4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: a1(1:) !< First data stream. + integer(I4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R4_I4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R4_I2(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: a1(1:) !< First data stream. + integer(I2P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R4_I2 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_R4_I1(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + real(R4P), intent(IN):: a1(1:) !< First data stream. + integer(I1P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_R4_I1 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I8_R8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: a1(1:) !< First data stream. + real(R8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I8_R8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I8_R4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: a1(1:) !< First data stream. + real(R4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I8_R4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I8_I4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: a1(1:) !< First data stream. + integer(I4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I8_I4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I8_I2(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: a1(1:) !< First data stream. + integer(I2P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I8_I2 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I8_I1(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I8P), intent(IN):: a1(1:) !< First data stream. + integer(I1P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I8_I1 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I4_R8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: a1(1:) !< First data stream. + real(R8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I4_R8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I4_R4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: a1(1:) !< First data stream. + real(R4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I4_R4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I4_I8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: a1(1:) !< First data stream. + integer(I8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I4_I8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I4_I2(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: a1(1:) !< First data stream. + integer(I2P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I4_I2 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I4_I1(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: a1(1:) !< First data stream. + integer(I1P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I4_I1 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I2_R8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: a1(1:) !< First data stream. + real(R8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I2_R8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I2_R4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: a1(1:) !< First data stream. + real(R4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I2_R4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I2_I8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: a1(1:) !< First data stream. + integer(I8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I2_I8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I2_I4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: a1(1:) !< First data stream. + integer(I4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I2_I4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I2_I1(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I2P), intent(IN):: a1(1:) !< First data stream. + integer(I1P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I2_I1 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I1_R8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: a1(1:) !< First data stream. + real(R8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I1_R8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I1_R4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: a1(1:) !< First data stream. + real(R4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I1_R4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I1_I8(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: a1(1:) !< First data stream. + integer(I8P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I1_I8 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I1_I4(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: a1(1:) !< First data stream. + integer(I4P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I1_I4 + + !> @brief Subroutine for packing different kinds of data into single I1P array. + pure subroutine pack_data_I1_I2(a1,a2,packed) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: a1(1:) !< First data stream. + integer(I2P), intent(IN):: a2(1:) !< Second data stream. + integer(I1P), allocatable, intent(INOUT):: packed(:) !< Packed data into I1P array. + integer(I1P), allocatable:: p1(:) !< Temporary packed data of first stream. + integer(I1P), allocatable:: p2(:) !< Temporary packed data of second stream. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + p1 = transfer(a1,p1) ; p2 = transfer(a2,p2) + if (allocated(packed)) deallocate(packed) ; allocate(packed(1:size(p1,dim=1)+size(p2,dim=1))) + packed = [p1,p2] + deallocate(p1,p2) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine pack_data_I1_I2 + + !> @brief Subroutine for encoding bits (must be multiple of 24 bits) into base64 charcaters code (of length multiple of 4). + !> @note The bits stream are encoded in chunks of 24 bits as the following example (in little endian order): + !> @code + !> +--first octet--+-second octet--+--third octet--+ + !> |7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0| + !> +-----------+---+-------+-------+---+-----------+ + !> |5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0| + !> +--1.index--+--2.index--+--3.index--+--4.index--+ + !> @endcode + !> The 4 indexes are stored into 4 elements 8 bits array, thus 2 bits of each array element are not used. + pure subroutine encode_bits(bits,padd,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I1P), intent(IN):: bits(1:) !< Bits to be encoded. + integer(I4P), intent(IN):: padd !< Number of padding characters ('='). + character(*), intent(OUT):: code !< Characters code. + integer(I1P):: sixb(1:4) !< 6 bits slices (stored into 8 bits integer) of 24 bits input. + integer(I8P):: c,e !< Counters. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + c = 1_I8P + do e=1_I8P,size(bits,dim=1),3_I8P ! loop over array elements: 3 bytes (24 bits) scanning + sixb = 0_I1P + call mvbits(bits(e ),2,6,sixb(1),0) + call mvbits(bits(e ),0,2,sixb(2),4) ; call mvbits(bits(e+1),4,4,sixb(2),0) + call mvbits(bits(e+1),0,4,sixb(3),2) ; call mvbits(bits(e+2),6,2,sixb(3),0) + call mvbits(bits(e+2),0,6,sixb(4),0) + sixb = sixb + 1_I1P + code(c :c ) = base64(sixb(1):sixb(1)) + code(c+1:c+1) = base64(sixb(2):sixb(2)) + code(c+2:c+2) = base64(sixb(3):sixb(3)) + code(c+3:c+3) = base64(sixb(4):sixb(4)) + c = c + 4_I8P + enddo + if (padd>0) code(len(code)-padd+1:)=repeat('=',padd) + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine encode_bits + + !> @brief Subroutine for encoding array numbers to base64 (R8P). + pure subroutine b64_encode_R8_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + real(R8P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_R8_a + + !> @brief Subroutine for encoding array numbers to base64 (R4P). + pure subroutine b64_encode_R4_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + real(R4P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_R4_a + + !> @brief Subroutine for encoding array numbers to base64 (I8P). + pure subroutine b64_encode_I8_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + integer(I8P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_I8_a + + !> @brief Subroutine for encoding array numbers to base64 (I4P). + pure subroutine b64_encode_I4_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + integer(I4P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_I4_a + + !> @brief Subroutine for encoding array numbers to base64 (I2P). + pure subroutine b64_encode_I2_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + integer(I2P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_I2_a + + !> @brief Subroutine for encoding array numbers to base64 (I1P). + pure subroutine b64_encode_I1_a(nB,n,code) + !--------------------------------------------------------------------------------------------------------------------------------- + implicit none + integer(I4P), intent(IN):: nB !< Number of bytes of single element of n. + integer(I1P), intent(IN):: n(1:) !< Array of numbers to be encoded. + character(((size(n,dim=1)*nB+2)/3)*4), intent(OUT):: code !< Encoded array. + integer(I1P):: nI1P(1:((size(n,dim=1)*nB+2)/3)*3) !< One byte integer array containing n. + integer(I4P):: padd !< Number of padding characters ('='). + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + nI1P = transfer(n,nI1P) ! casting n to integer array of 1 byte elements + padd = mod((size(n,dim=1)*nB),3_I4P) ; if (padd>0_I4P) padd = 3_I4P - padd ! computing the number of padding characters + call encode_bits(bits=nI1P,padd=padd,code=code) ! encoding bits + return + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine b64_encode_I1_a + + !!> @brief Subroutine for decoding array numbers from base64 (R8P). + !pure subroutine b64_decode_R8_a(code,n) + !!-------------------------------------------------------------------------------------------------------------------------------- + !implicit none + !real(R8P), intent(OUT):: n(1:) !< Number to be decoded. + !character(ncR8P*size(n,dim=1)), intent(IN):: code !< Encoded number. + !integer(I4P):: c,d !< Counters. + !!-------------------------------------------------------------------------------------------------------------------------------- + + !!-------------------------------------------------------------------------------------------------------------------------------- + !d = 1_I4P + !do c=1,len(code),ncR8P + ! call b64_decode_R8_s(code=code(c:c+ncR8P-1),n=n(d)) + ! d = d + 1_I4P + !enddo + !return + !!-------------------------------------------------------------------------------------------------------------------------------- + !endsubroutine b64_decode_R8_a + !> @} +endmodule Lib_Base64 diff --git a/lib/Lib_VTK_IO.f90 b/lib/Lib_VTK_IO.f90 index 85cd70970..385ac355d 100644 --- a/lib/Lib_VTK_IO.f90 +++ b/lib/Lib_VTK_IO.f90 @@ -26,16 +26,15 @@ !> @brief This is a library of functions for Input and Output pure Fortran data in VTK format. !> @details It is useful for Paraview visualization tool. Even though there are many wrappers/porting of the VTK source !> code (C++ code), there is not a Fortran one. This library is not a porting or a wrapper of the VTK code, -!> but it only an exporter/importer of the VTK data format written in pure Fortran language (standard Fortran 2003) -!> that can be used by Fortran coders (yes, there are still a lot of these brave coders...) without mixing Fortran with -!> C++ language. Fortran is still the best language for high performance computing for scientific purpose, like CFD +!> but it only an exporter/importer of the VTK data format written in pure Fortran language (standard Fortran 2003 or +!> higher) that can be used by Fortran coders (yes, there are still a lot of these brave coders...) without mixing Fortran +!> with C++ language. Fortran is still the best language for high performance computing for scientific purpose, like CFD !> computing. It is necessary a tool to deal with VTK standard directly by Fortran code. The library was made to fill !> this empty: it is a simple Fortran module able to export native Fortran data into VTK data format and to import VTK !> data into a Fortran code, both in ascii and binary file format. !> !> The library provides an automatic way to deal with VTK data format: all the formatting processes is nested into the -!> library and users communicate with it by a simple API passing only native Fortran data (native Fortran scalar, vector -!> and matrix). +!> library and users communicate with it by a simple API passing only native Fortran data (Fortran scalars and arrays). !> !> The library is still in developing and testing, this is first usable release, but there are not all the features of !> the stable release (the importer is totally absent and the exporter is not complete). Surely there are a lot of bugs @@ -106,14 +105,20 @@ !> variables and dynamic dispatching. Using dynamic dispatching @libvtk has a simple API. The user calls !> a generic procedure (VTK_INI, VTK_GEO,...) and the library, depending on the type and number of the inputs passed, calls the !> correct internal function (i.e. VTK_GEO for R8P real type if the input passed is R8P real type). By this interface only few -!> functions are used without the necessity of calling a different function for every different inputs type. -!> Dynamic dispatching is based on the internal kind-precision selecting convention: Fortran 90/95 standard has introduced some +!> functions are used without the necessity of calling a different function for each different input type. +!> Dynamic dispatching is based on the internal kind-precision/rank selecting convention: Fortran 90/95 standard has introduced some !> useful functions to achieve the portability of reals and integers precision and @libvtk uses these functions to define portable !> kind-precision; to this aim @libvtk uses IR_Precision module. !> @author Stefano Zaghi !> @version 1.1 !> @date 2013-04-26 !> @par News +!> - Added base64 encoding format: the output format specifier of VTK_INI_XML has been changed: +!> - output_format = 'ascii' means \b ascii data, the same as the previous version; +!> - output_format = 'binary' means \b base64 encoded data, different from the previous version where it meant appended +!> raw-binary data; base64 encoding was missing in the previous version; +!> - output_format = 'raw' means \b appended \b raw-binary data, as 'binary' of the previous version; +!> - Added support for OpenMP multi-threads framework; !> - 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; @@ -138,15 +143,16 @@ !> could be: \n \n !> E_IO = VTK_VAR_XML(NC_NN=nn,varname='u',var=\b reshape(u(ni1:ni2,nj1:nj2,nk1:nk2),(/nn/))) \n \n !> where built in function \em reshape has explicitly being used in the calling to VTK_VAR_XML. -!> @bug XML-Efficiency: \n This is not properly a bug. There is an inefficiency when saving XML binary file. To write XML -!> binary @libvtk uses a temporary scratch file to save binary data while saving all formatting data to -!> 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 XML-Efficiency: \n This is not properly a bug. There is an inefficiency when saving XML raw (binary) file. To write +!> raw data into XML file @libvtk uses a temporary scratch file to save binary data while saving all +!> formatting data to 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 +!> \b appended data. This approach is not efficient. !> @ingroup Lib_VTK_IOLibrary module Lib_VTK_IO !----------------------------------------------------------------------------------------------------------------------------------- USE IR_Precision ! Integers and reals precision definition. +USE Lib_Base64 ! Base64 encoding/decoding procedures. USE, intrinsic:: ISO_FORTRAN_ENV, only: stdout=>OUTPUT_UNIT, stderr=>ERROR_UNIT ! Standard output/error logical units. !----------------------------------------------------------------------------------------------------------------------------------- @@ -384,7 +390,8 @@ endinterface integer(I4P), parameter:: maxlen = 500 !< Max number of characters of static string. character(1), parameter:: end_rec = char(10) !< End-character for binary-record finalize. integer(I4P), parameter:: ascii = 0 !< Ascii-output-format parameter identifier. -integer(I4P), parameter:: binary = 1 !< Binary-output-format parameter identifier. +integer(I4P), parameter:: binary = 1 !< Base64-output-format parameter identifier. +integer(I4P), parameter:: raw = 2 !< Raw-appended-binary-output-format parameter identifier. ! VTK file data: type:: Type_VTK_File integer(I4P):: f = ascii !< Current output-format (initialized to ascii format). @@ -526,7 +533,7 @@ contains allocate(vtk(1:Nvtk)) cf = Nvtk endif - case('REMOVE') + case default if (Nvtk>1_I4P) then allocate(vtk_tmp(1:Nvtk-1)) if (cf==Nvtk) then @@ -567,9 +574,12 @@ contains !> Note that the file extension is necessary in the file name. The XML standard has different extensions for each !> different topologies (e.g. \em vtr for rectilinear topology). See the VTK-standard file for more information. !> @return E_IO: integer(I4P) error flag - function VTK_INI_XML(cf,nx1,nx2,ny1,ny2,nz1,nz2,output_format,filename,mesh_topology) result(E_IO) + function VTK_INI_XML(output_format,filename,mesh_topology,cf,nx1,nx2,ny1,ny2,nz1,nz2) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none + character(*), intent(IN):: output_format !< Output format: ASCII or RAW, or BINARY. + character(*), intent(IN):: filename !< File name. + character(*), intent(IN):: mesh_topology !< Mesh topology. integer(I4P), intent(OUT), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: nx1 !< Initial node of x axis. integer(I4P), intent(IN), optional:: nx2 !< Final node of x axis. @@ -577,15 +587,13 @@ contains integer(I4P), intent(IN), optional:: ny2 !< Final node of y axis. integer(I4P), intent(IN), optional:: nz1 !< Initial node of z axis. integer(I4P), intent(IN), optional:: nz2 !< Final node of z axis. - character(*), intent(IN):: output_format !< Output format: ASCII or BINARY. - character(*), intent(IN):: filename !< File name. - 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P if (.not.ir_initialized) call IR_Init call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) f = rf @@ -614,8 +622,8 @@ contains s_buffer = repeat(' ',vtk(rf)%indent)//'<'//trim(vtk(rf)%topology)//'>' endselect write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)trim(s_buffer) ; vtk(rf)%indent = vtk(rf)%indent + 2 - case('BINARY') - vtk(rf)%f = binary + case('RAW') + vtk(rf)%f = raw 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 @@ -639,6 +647,28 @@ contains ! opening the SCRATCH file used for appending raw binary data 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 + case('BINARY') + 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(rf)%u,iostat=E_IO)''//end_rec + if (endian==endianL) then + s_buffer = '' + else + s_buffer = '' + endif + 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(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(rf)%indent)//'<'//trim(vtk(rf)%topology)//'>' + endselect + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -648,16 +678,17 @@ contains !> @{ !> Function for open/close field data tag. !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_OC(cf,fld_action) result(E_IO) + function VTK_FLD_XML_OC(fld_action,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -667,14 +698,14 @@ contains select case(vtk(rf)%f) case(ascii) write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' ; vtk(rf)%indent = vtk(rf)%indent + 2 - case(binary) + case(raw,binary) 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(rf)%f) case(ascii) vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw,binary) vtk(rf)%indent = vtk(rf)%indent - 2 ; write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect endselect @@ -684,18 +715,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_R8(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_R8(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). real(R8P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((8+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -705,13 +739,21 @@ contains 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) + case(raw) 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 + case(binary) + call pack_data(a1=[int(BYR8P,I4P)],a2=[fld],packed=fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -719,18 +761,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_R4(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_R4(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). real(R4P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((4+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -740,13 +785,21 @@ contains 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) + case(raw) 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 + case(binary) + call pack_data(a1=[int(BYR4P,I4P)],a2=[fld],packed=fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -754,18 +807,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (I8P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_I8(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_I8(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I8P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((8+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -775,13 +831,21 @@ contains 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) + case(raw) 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 + case(binary) + call pack_data(a1=[int(BYI8P,I4P)],a2=[fld],packed=fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -789,18 +853,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_I4(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_I4(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((4+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -810,13 +877,21 @@ contains 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) + case(raw) 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 + case(binary) + fldp = transfer([int(BYI4P,I4P),fld],fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -824,18 +899,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (I2P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_I2(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_I2(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I2P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((2+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -845,13 +923,21 @@ contains 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) + case(raw) 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 + case(binary) + call pack_data(a1=[int(BYI2P,I4P)],a2=[fld],packed=fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -859,18 +945,21 @@ contains !> Function for saving field data (global auxiliary data, e.g. time, step number, data set name...) (I1P). !> @return E_IO: integer(I4P) error flag - function VTK_FLD_XML_I1(cf,fld,fname) result(E_IO) + function VTK_FLD_XML_I1(fld,fname,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I1P), intent(IN):: fld !< Field data value. character(*), intent(IN):: fname !< Field data name. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: fldp(:) !< Packed field data. + character(((1+4+2)/3)*4):: fld64 !< Field data encoded in base64. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -880,13 +969,21 @@ contains 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) + case(raw) 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 + case(binary) + call pack_data(a1=[int(BYI1P,I4P)],a2=[fld],packed=fldp) + call b64_encode(nB=int(BYI1P,I4P),n=fldp,code=fld64) + deallocate(fldp) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//fld64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -894,10 +991,9 @@ contains !> Function for saving mesh with \b StructuredGrid topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_STRG_R8(cf,nx1,nx2,ny1,ny2,nz1,nz2,NN,X,Y,Z) result(E_IO) + function VTK_GEO_XML_STRG_R8(nx1,nx2,ny1,ny2,nz1,nz2,NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: nx1 !< Initial node of x axis. integer(I4P), intent(IN):: nx2 !< Final node of x axis. integer(I4P), intent(IN):: ny1 !< Initial node of y axis. @@ -908,13 +1004,18 @@ contains 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), 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. + real(R8P), allocatable:: XYZ(:) !< X, Y, Z coordinates. + integer(I1P), allocatable:: XYZp(:) !< Packed coordinates data. + character(((3*NN*8+4+2)/3)*4):: XYZ64 !< X, Y, Z coordinates encoded in base64. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -922,19 +1023,21 @@ contains select case(vtk(rf)%f) case(ascii) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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) + do n1=1,NN + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//str(n=X(n1))//' '//str(n=Y(n1))//' '//str(n=Z(n1)) + enddo 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) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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)// & @@ -945,6 +1048,25 @@ contains 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 + case(binary) + 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(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + allocate(XYZ(1:3*NN)) + do n1 = 1,NN + XYZ(1+(n1-1)*3:1+(n1-1)*3+2)=[X(n1),Y(n1),Z(n1)] + enddo + call pack_data(a1=[int(3*NN*BYR8P,I4P)],a2=XYZ,packed=XYZp) + deallocate(XYZ) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=XYZ64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//XYZ64//end_rec + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -952,10 +1074,9 @@ contains !> Function for saving mesh with \b StructuredGrid topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_STRG_R4(cf,nx1,nx2,ny1,ny2,nz1,nz2,NN,X,Y,Z) result(E_IO) + function VTK_GEO_XML_STRG_R4(nx1,nx2,ny1,ny2,nz1,nz2,NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: nx1 !< Initial node of x axis. integer(I4P), intent(IN):: nx2 !< Final node of x axis. integer(I4P), intent(IN):: ny1 !< Initial node of y axis. @@ -966,13 +1087,18 @@ contains 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), 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. character(len=maxlen):: s_buffer !< Buffer string. + real(R4P), allocatable:: XYZ(:) !< X, Y, Z coordinates. + integer(I1P), allocatable:: XYZp(:) !< Packed data. + character(((3*NN*4+4+2)/3)*4):: XYZ64 !< X, Y, Z coordinates encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -980,19 +1106,21 @@ contains select case(vtk(rf)%f) case(ascii) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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) + do n1=1,NN + write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//str(n=X(n1))//' '//str(n=Y(n1))//' '//str(n=Z(n1)) + enddo 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) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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)// & @@ -1003,6 +1131,25 @@ contains 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 + case(binary) + 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(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + allocate(XYZ(1:3*NN)) + do n1 = 1,NN + XYZ(1+(n1-1)*3:1+(n1-1)*3+2)=[X(n1),Y(n1),Z(n1)] + enddo + call pack_data(a1=[int(3*NN*BYR4P,I4P)],a2=XYZ,packed=XYZp) + deallocate(XYZ) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=XYZ64) + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//XYZ64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1010,26 +1157,31 @@ contains !> Function for saving mesh with \b RectilinearGrid topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_RECT_R8(cf,nx1,nx2,ny1,ny2,nz1,nz2,X,Y,Z) result(E_IO) + function VTK_GEO_XML_RECT_R8(nx1,nx2,ny1,ny2,nz1,nz2,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: nx1 !< Initial node of x axis. - integer(I4P), intent(IN):: nx2 !< Final node of x axis. - integer(I4P), intent(IN):: ny1 !< Initial node of y axis. - integer(I4P), intent(IN):: ny2 !< Final node of y axis. - integer(I4P), intent(IN):: nz1 !< Initial node of z axis. - integer(I4P), intent(IN):: nz2 !< Final node of z axis. - real(R8P), intent(IN):: X(nx1:nx2) !< X coordinates. - real(R8P), intent(IN):: Y(ny1:ny2) !< Y coordinates. - 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. + integer(I4P), intent(IN):: nx1 !< Initial node of x axis. + integer(I4P), intent(IN):: nx2 !< Final node of x axis. + integer(I4P), intent(IN):: ny1 !< Initial node of y axis. + integer(I4P), intent(IN):: ny2 !< Final node of y axis. + integer(I4P), intent(IN):: nz1 !< Initial node of z axis. + integer(I4P), intent(IN):: nz2 !< Final node of z axis. + real(R8P), intent(IN):: X(nx1:nx2) !< X coordinates. + real(R8P), intent(IN):: Y(ny1:ny2) !< Y coordinates. + real(R8P), intent(IN):: Z(nz1:nz2) !< Z coordinates. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: XYZp(:) !< Packed data. + character((((nx2-nx1+1)*8+4+2)/3)*4):: X64 !< X coordinates encoded in base64. + character((((ny2-ny1+1)*8+4+2)/3)*4):: Y64 !< Y coordinates encoded in base64. + character((((nz2-nz1+1)*8+4+2)/3)*4):: Z64 !< Z coordinates encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1037,8 +1189,8 @@ contains select case(vtk(rf)%f) case(ascii) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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)//'' @@ -1051,10 +1203,10 @@ contains 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) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' + trim(str(n=ny1))//' '//trim(str(n=ny2))//' '// & + trim(str(n=nz1))//' '//trim(str(n=nz2))//'">' 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 ; 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 ; 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 pack_data(a1=[int((nx2-nx1+1)*BYR8P,I4P)],a2=X,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=X64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//X64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int((ny2-ny1+1)*BYR8P,I4P)],a2=Y,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=Y64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//Y64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int((nz2-nz1+1)*BYR8P,I4P)],a2=Z,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=Z64) + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//Z64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1083,26 +1263,31 @@ contains !> Function for saving mesh with \b RectilinearGrid topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_RECT_R4(cf,nx1,nx2,ny1,ny2,nz1,nz2,X,Y,Z) result(E_IO) + function VTK_GEO_XML_RECT_R4(nx1,nx2,ny1,ny2,nz1,nz2,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: nx1 !< Initial node of x axis. - integer(I4P), intent(IN):: nx2 !< Final node of x axis. - integer(I4P), intent(IN):: ny1 !< Initial node of y axis. - integer(I4P), intent(IN):: ny2 !< Final node of y axis. - integer(I4P), intent(IN):: nz1 !< Initial node of z axis. - integer(I4P), intent(IN):: nz2 !< Final node of z axis. - real(R4P), intent(IN):: X(nx1:nx2) !< X coordinates. - real(R4P), intent(IN):: Y(ny1:ny2) !< Y coordinates. - 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. + integer(I4P), intent(IN):: nx1 !< Initial node of x axis. + integer(I4P), intent(IN):: nx2 !< Final node of x axis. + integer(I4P), intent(IN):: ny1 !< Initial node of y axis. + integer(I4P), intent(IN):: ny2 !< Final node of y axis. + integer(I4P), intent(IN):: nz1 !< Initial node of z axis. + integer(I4P), intent(IN):: nz2 !< Final node of z axis. + real(R4P), intent(IN):: X(nx1:nx2) !< X coordinates. + real(R4P), intent(IN):: Y(ny1:ny2) !< Y coordinates. + real(R4P), intent(IN):: Z(nz1:nz2) !< Z coordinates. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: XYZp(:) !< Packed data. + character((((nx2-nx1+1)*4+4+2)/3)*4):: X64 !< X coordinates encoded in base64. + character((((ny2-ny1+1)*4+4+2)/3)*4):: Y64 !< Y coordinates encoded in base64. + character((((nz2-nz1+1)*4+4+2)/3)*4):: Z64 !< Z coordinates encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1124,7 +1309,7 @@ contains 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) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' @@ -1149,6 +1334,34 @@ contains 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 + case(binary) + 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 + 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 + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int((nx2-nx1+1)*BYR4P,I4P)],a2=X,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=X64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//X64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int((ny2-ny1+1)*BYR4P,I4P)],a2=Y,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=Y64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//Y64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int((nz2-nz1+1)*BYR4P,I4P)],a2=Z,packed=XYZp) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=Z64) + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//Z64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1156,22 +1369,26 @@ contains !> Function for saving mesh with \b UnstructuredGrid topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_UNST_R8(cf,NN,NC,X,Y,Z) result(E_IO) + function VTK_GEO_XML_UNST_R8(NN,NC,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NN !< Number of nodes. integer(I4P), intent(IN):: NC !< Number of cells. 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), 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. character(len=maxlen):: s_buffer !< Buffer string. + real(R8P), allocatable:: XYZ(:) !< X, Y, Z coordinates. + integer(I1P), allocatable:: XYZp(:) !< Packed data. + character(((3*NN*8+4+2)/3)*4):: XYZ64 !< X, Y, Z coordinates encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1186,7 +1403,7 @@ contains 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) + case(raw) 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 @@ -1198,6 +1415,23 @@ contains 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 + case(binary) + 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(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + allocate(XYZ(1:3*NN)) + do n1 = 1,NN + XYZ(1+(n1-1)*3:1+(n1-1)*3+2)=[X(n1),Y(n1),Z(n1)] + enddo + call pack_data(a1=[int(3*NN*BYR8P,I4P)],a2=XYZ,packed=XYZp) + deallocate(XYZ) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=XYZ64) + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//XYZ64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1205,22 +1439,26 @@ contains !> Function for saving mesh with \b UnstructuredGrid topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_XML_UNST_R4(cf,NN,NC,X,Y,Z) result(E_IO) + function VTK_GEO_XML_UNST_R4(NN,NC,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NN !< Number of nodes. integer(I4P), intent(IN):: NC !< Number of cells. 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), 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. character(len=maxlen):: s_buffer !< Buffer string. + real(R4P), allocatable:: XYZ(:) !< X, Y, Z coordinates. + integer(I1P), allocatable:: XYZp(:) !< Packed data. + character(((3*NN*4+4+2)/3)*4):: XYZ64 !< X, Y, Z coordinates encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1235,7 +1473,7 @@ contains 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) + case(raw) 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 @@ -1247,6 +1485,23 @@ contains 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 + case(binary) + 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(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + allocate(XYZ(1:3*NN)) + do n1 = 1,NN + XYZ(1+(n1-1)*3:1+(n1-1)*3+2)=[X(n1),Y(n1),Z(n1)] + enddo + call pack_data(a1=[int(3*NN*BYR4P,I4P)],a2=XYZ,packed=XYZp) + deallocate(XYZ) + call b64_encode(nB=int(BYI1P,I4P),n=XYZp,code=XYZ64) + deallocate(XYZp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//XYZ64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1263,6 +1518,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1271,7 +1527,7 @@ contains select case(vtk(rf)%f) case(ascii) write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw,binary) write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return @@ -1321,21 +1577,26 @@ contains !> second cell \n !> cell_type(2) = 14 pyramid type of \f$2^\circ\f$ cell \n !> @return E_IO: integer(I4P) error flag - function VTK_CON_XML(cf,NC,connect,offset,cell_type) result(E_IO) + function VTK_CON_XML(NC,connect,offset,cell_type,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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):: offset(1:NC) !< Cell offset. - 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. + integer(I4P), intent(IN):: NC !< Number of cells. + integer(I4P), intent(IN):: connect(:) !< Mesh connectivity. + integer(I4P), intent(IN):: offset(1:NC) !< Cell offset. + integer(I1P), intent(IN):: cell_type(1:NC) !< VTK cell type. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: cocp(:) !< Packed data. + character(((size(connect,dim=1)*4+4+2)/3)*4):: con64 !< Connectivity encoded in base64. + character(((Nc*4+4+2)/3)*4):: off64 !< Offset encoded in base64. + character(((NC*1+4+2)/3)*4):: cel64 !< Cell type encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1344,7 +1605,7 @@ contains case(ascii) 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=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)//'' @@ -1354,7 +1615,7 @@ contains 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) + case(raw) 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)//'' @@ -1375,6 +1636,26 @@ contains 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 + case(binary) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec ; vtk(rf)%indent = vtk(rf)%indent + 2 + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//& + ''//end_rec + cocp = transfer([int(size(connect,dim=1)*BYI4P,I4P),connect],cocp) + call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=con64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//con64//end_rec + 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 + cocp = transfer([int(NC*BYI4P,I4P),offset],cocp) + call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=off64) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//off64//end_rec + 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 + call pack_data(a1=[int(NC*BYI1P,I4P)],a2=cell_type,packed=cocp) + call b64_encode(nB=int(BYI1P,I4P),n=cocp,code=cel64) + deallocate(cocp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//cel64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%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 return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1395,17 +1676,18 @@ contains !> ... @endcode !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function VTK_DAT_XML(cf,var_location,var_block_action) result(E_IO) + function VTK_DAT_XML(var_location,var_block_action,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1428,7 +1710,7 @@ contains 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) + case(raw,binary) select case(trim(Upper_Case(var_location))) case('CELL') select case(trim(Upper_Case(var_block_action))) @@ -1455,20 +1737,23 @@ contains !> Function for saving field of scalar variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_R8(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_R8(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. real(R8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*8+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1480,13 +1765,22 @@ contains 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(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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int(NC_NN*BYR8P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1494,20 +1788,23 @@ contains !> Function for saving field of scalar variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_R4(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_R4(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. real(R4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*4+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1519,13 +1816,22 @@ contains 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(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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int(NC_NN*BYR4P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1533,20 +1839,23 @@ contains !> Function for saving field of scalar variable (I8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_I8(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_I8(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. integer(I8P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*8+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1558,13 +1867,22 @@ contains 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(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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int(NC_NN*BYI8P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1572,20 +1890,23 @@ contains !> Function for saving field of scalar variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_I4(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_I4(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. integer(I4P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*4+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1597,13 +1918,22 @@ contains 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) + case(raw) 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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + varp = transfer([int(NC_NN*BYI4P,I4P),var],varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1611,20 +1941,23 @@ contains !> Function for saving field of scalar variable (I2P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_I2(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_I2(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. integer(I2P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*2+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1636,13 +1969,22 @@ contains 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(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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int(NC_NN*BYI2P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1650,20 +1992,23 @@ contains !> Function for saving field of scalar variable (I1P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_SCAL_I1(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_XML_SCAL_I1(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. character(*), intent(IN):: varname !< Variable name. integer(I1P), intent(IN):: var(1:NC_NN) !< Variable to be saved. + 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. character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((NC_NN*1+4+2)/3)*4):: var64 !< Variable encoded in base64. integer(I4P):: rf !< Real file index. integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1674,13 +2019,22 @@ contains 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(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) + case(binary) + s_buffer=repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + call pack_data(a1=[int(NC_NN*BYI1P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1688,22 +2042,26 @@ contains !> Function for saving field of vectorial variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_R8(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_R8(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - real(R8P), intent(IN):: varX(1:NC_NN) !< X component. - real(R8P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + real(R8P), intent(IN):: varX(1:NC_NN) !< X component. + real(R8P), intent(IN):: varY(1:NC_NN) !< Y component. + real(R8P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + real(R8P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*8+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1715,13 +2073,25 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + call pack_data(a1=[int(3*NC_NN*BYR8P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1729,22 +2099,26 @@ contains !> Function for saving field of vectorial variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_R4(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_R4(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - real(R4P), intent(IN):: varX(1:NC_NN) !< X component. - real(R4P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + real(R4P), intent(IN):: varX(1:NC_NN) !< X component. + real(R4P), intent(IN):: varY(1:NC_NN) !< Y component. + real(R4P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + real(R4P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*4+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1756,13 +2130,25 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + call pack_data(a1=[int(3*NC_NN*BYR4P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1770,22 +2156,26 @@ contains !> Function for saving field of vectorial variable (I8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_I8(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_I8(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - integer(I8P), intent(IN):: varX(1:NC_NN) !< X component. - integer(I8P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + integer(I8P), intent(IN):: varX(1:NC_NN) !< X component. + integer(I8P), intent(IN):: varY(1:NC_NN) !< Y component. + integer(I8P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I8P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*8+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1797,13 +2187,25 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + call pack_data(a1=[int(3*NC_NN*BYI8P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1811,22 +2213,26 @@ contains !> Function for saving field of vectorial variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_I4(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_I4(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - integer(I4P), intent(IN):: varX(1:NC_NN) !< X component. - integer(I4P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + integer(I4P), intent(IN):: varX(1:NC_NN) !< X component. + integer(I4P), intent(IN):: varY(1:NC_NN) !< Y component. + integer(I4P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I4P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*4+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1838,13 +2244,25 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + varp = transfer([int(3*NC_NN*BYI4P,I4P),var],varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1852,22 +2270,26 @@ contains !> Function for saving field of vectorial variable (I2P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_I2(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_I2(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - integer(I2P), intent(IN):: varX(1:NC_NN) !< X component. - integer(I2P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + integer(I2P), intent(IN):: varX(1:NC_NN) !< X component. + integer(I2P), intent(IN):: varY(1:NC_NN) !< Y component. + integer(I2P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I2P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*2+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1879,13 +2301,25 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + call pack_data(a1=[int(3*NC_NN*BYI2P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1893,22 +2327,26 @@ contains !> Function for saving field of vectorial variable (I1P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_VECT_I1(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_XML_VECT_I1(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. - character(*), intent(IN):: varname !< Variable name. - integer(I1P), intent(IN):: varX(1:NC_NN) !< X component. - integer(I1P), intent(IN):: varY(1:NC_NN) !< Y component. - 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. + integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. + character(*), intent(IN):: varname !< Variable name. + integer(I1P), intent(IN):: varX(1:NC_NN) !< X component. + integer(I1P), intent(IN):: varY(1:NC_NN) !< Y component. + integer(I1P), intent(IN):: varZ(1:NC_NN) !< Z component. + 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. + character(len=maxlen):: s_buffer !< Buffer string. + integer(I1P):: var(1:3*NC_NN) !< X, Y, Z component. + integer(I1P), allocatable:: varp(:) !< Packed data. + character(((3*NC_NN*1+4+2)/3)*4):: var64 !< Variable encoded in base64. + integer(I4P):: rf !< Real file index. + integer(I4P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1919,14 +2357,26 @@ contains 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(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) + case(binary) + s_buffer = repeat(' ',vtk(rf)%indent)//'' + write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec + do n1=1,NC_NN + var(1+(n1-1)*3:1+(n1-1)*3+2)=[varX(n1),varY(n1),varZ(n1)] + enddo + call pack_data(a1=[int(3*NC_NN*BYI1P,I4P)],a2=var,packed=varp) + call b64_encode(nB=int(BYI1P,I4P),n=varp,code=var64) + deallocate(varp) + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent+2)//var64//end_rec + write(unit=vtk(rf)%u,iostat=E_IO)repeat(' ',vtk(rf)%indent)//''//end_rec endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1934,14 +2384,14 @@ contains !> Function for saving field of list variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_R8(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_R8(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. real(R8P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -1949,6 +2399,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -1962,7 +2413,7 @@ contains write(unit=vtk(rf)%u,fmt=FR8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -1971,6 +2422,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -1978,14 +2430,14 @@ contains !> Function for saving field of list variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_R4(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_R4(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. real(R4P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -1993,6 +2445,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2006,7 +2459,7 @@ contains write(unit=vtk(rf)%u,fmt=FR4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -2015,6 +2468,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2022,14 +2476,14 @@ contains !> Function for saving field of list variable (I8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_I8(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_I8(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. integer(I8P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2037,6 +2491,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2050,7 +2505,7 @@ contains write(unit=vtk(rf)%u,fmt=FI8P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -2059,6 +2514,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2066,14 +2522,14 @@ contains !> Function for saving field of list variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_I4(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_I4(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. integer(I4P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2081,6 +2537,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2094,7 +2551,7 @@ contains write(unit=vtk(rf)%u,fmt=FI4P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -2103,6 +2560,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2110,14 +2568,14 @@ contains !> Function for saving field of list variable (I2P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_I2(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_I2(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. integer(I2P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2125,6 +2583,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2138,7 +2597,7 @@ contains write(unit=vtk(rf)%u,fmt=FI2P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -2147,6 +2606,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2154,14 +2614,14 @@ contains !> Function for saving field of list variable (I1P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_XML_LIST_I1(cf,NC_NN,N_COL,varname,var) result(E_IO) + function VTK_VAR_XML_LIST_I1(NC_NN,N_COL,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN):: NC_NN !< Number of cells or nodes. integer(I4P), intent(IN):: N_COL !< Number of columns. character(*), intent(IN):: varname !< Variable name. integer(I1P), intent(IN):: var(1:,1:) !< Components. + 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2169,6 +2629,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2182,7 +2643,7 @@ contains write(unit=vtk(rf)%u,fmt=FI1P,iostat=E_IO)(var(n1,n2),n2=1,N_COL) enddo write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)repeat(' ',vtk(rf)%indent)//'' - case(binary) + case(raw) s_buffer = repeat(' ',vtk(rf)%indent)//'' write(unit=vtk(rf)%u,iostat=E_IO)trim(s_buffer)//end_rec @@ -2191,6 +2652,7 @@ contains do n1=1,NC_NN write(unit=vtk(rf)%ua,iostat=E_IO)var(n1,:) enddo + case(binary) endselect return !--------------------------------------------------------------------------------------------------------------------------------- @@ -2227,6 +2689,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2236,7 +2699,7 @@ contains 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) + case(raw) 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 @@ -2288,6 +2751,10 @@ contains 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) + case(binary) + 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)''//end_rec endselect close(unit=vtk(rf)%u,iostat=E_IO) call vtk_update(act='remove',cf=rf,Nvtk=Nvtk,vtk=vtk) @@ -2309,6 +2776,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P if (.not.ir_initialized) call IR_Init if (endian==endianL) then s_buffer='' @@ -2335,6 +2803,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P select case(trim(Upper_Case(block_action))) case('OPEN') vtm%blk = vtm%blk + 1 @@ -2359,6 +2828,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P do f=1,size(flist) write(unit=vtm%u,fmt='(A)',iostat=E_IO)repeat(' ',vtm%indent)//'' @@ -2378,6 +2848,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P vtm%indent = vtm%indent - 2 write(unit=vtm%u,fmt='(A)',iostat=E_IO)repeat(' ',vtm%indent)//'' write(unit=vtm%u,fmt='(A)',iostat=E_IO)'' @@ -2389,9 +2860,12 @@ contains !> @brief Function for initializing parallel (partitioned) VTK-XML file. !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function PVTK_INI_XML(cf,nx1,nx2,ny1,ny2,nz1,nz2,filename,mesh_topology,tp) result(E_IO) + function PVTK_INI_XML(filename,mesh_topology,tp,cf,nx1,nx2,ny1,ny2,nz1,nz2) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none + character(*), intent(IN):: filename !< File name. + character(*), intent(IN):: mesh_topology !< Mesh topology. + character(*), intent(IN):: tp !< Type of geometry representation (Float32, Float64, ecc). integer(I4P), intent(OUT), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: nx1 !< Initial node of x axis. integer(I4P), intent(IN), optional:: nx2 !< Final node of x axis. @@ -2399,15 +2873,13 @@ contains integer(I4P), intent(IN), optional:: ny2 !< Final node of y axis. integer(I4P), intent(IN), optional:: nz1 !< Initial node of z axis. integer(I4P), intent(IN), optional:: nz2 !< Final node of z axis. - character(*), intent(IN):: filename !< File name. - character(*), intent(IN):: mesh_topology !< Mesh topology. - 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P if (.not.ir_initialized) call IR_Init call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) f = rf @@ -2459,9 +2931,10 @@ contains !> Function for saving piece geometry source for parallel (partitioned) VTK-XML file. !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function PVTK_GEO_XML(cf,nx1,nx2,ny1,ny2,nz1,nz2,source) result(E_IO) + function PVTK_GEO_XML(source,cf,nx1,nx2,ny1,ny2,nz1,nz2) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none + character(*), intent(IN):: source !< Source file name containing the piece data. integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). integer(I4P), intent(IN), optional:: nx1 !< Initial node of x axis. integer(I4P), intent(IN), optional:: nx2 !< Final node of x axis. @@ -2469,13 +2942,13 @@ contains integer(I4P), intent(IN), optional:: ny2 !< Final node of y axis. integer(I4P), intent(IN), optional:: nz1 !< Initial node of z axis. integer(I4P), intent(IN), optional:: nz2 !< Final node of z axis. - 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2497,17 +2970,18 @@ contains !> Function that \b must be called before saving the data related to geometric mesh, this function initializes the !> saving of data variables indicating the \em type (node or cell centered) of variables that will be saved. !> @ingroup Lib_VTK_IOPublicProcedure - function PVTK_DAT_XML(cf,var_location,var_block_action) result(E_IO) + function PVTK_DAT_XML(var_location,var_block_action,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2535,19 +3009,20 @@ contains !> Function for saving variable associated to nodes or cells geometry. !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function PVTK_VAR_XML(cf,Nc,varname,tp) result(E_IO) + function PVTK_VAR_XML(varname,tp,cf,Nc) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). - integer(I4P), intent(IN), optional:: Nc !< Number of components of variable. character(*), intent(IN):: varname !< Variable name. character(*), intent(IN):: tp !< Type of data representation (Float32, Float64, ecc). + integer(I4P), intent(IN), optional:: cf !< Current file index (for concurrent files IO). + integer(I4P), intent(IN), optional:: Nc !< Number of components of variable. 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2575,6 +3050,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2598,19 +3074,20 @@ contains !> ... @endcode !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function VTK_INI(cf,output_format,filename,title,mesh_topology) result(E_IO) + function VTK_INI(output_format,filename,title,mesh_topology,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - integer(I4P), intent(OUT), optional:: cf !< Current file index (for concurrent files IO). - character(*), intent(IN):: output_format !< Output format: ASCII or BINARY. + character(*), intent(IN):: output_format !< Output format: ASCII or RAW. character(*), intent(IN):: filename !< Name of file. character(*), intent(IN):: title !< Title. character(*), intent(IN):: mesh_topology !< Mesh topology. + integer(I4P), intent(OUT), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P if (.not.ir_initialized) call IR_Init call vtk_update(act='add',cf=rf,Nvtk=Nvtk,vtk=vtk) f = rf @@ -2626,8 +3103,8 @@ contains 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(rf)%f = binary + case('RAW') + vtk(rf)%f = raw 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 @@ -2644,10 +3121,9 @@ contains !> @{ !> Function for saving mesh with \b STRUCTURED_POINTS topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRP_R8(cf,Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) + function VTK_GEO_STRP_R8(Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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. @@ -2657,12 +3133,14 @@ contains 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2672,7 +3150,7 @@ contains 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) + case(raw) 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 @@ -2686,10 +3164,9 @@ contains !> Function for saving mesh with \b STRUCTURED_POINTS topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRP_R4(cf,Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz) result(E_IO) + function VTK_GEO_STRP_R4(Nx,Ny,Nz,X0,Y0,Z0,Dx,Dy,Dz,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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. @@ -2699,12 +3176,14 @@ contains 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2714,7 +3193,7 @@ contains 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) + case(raw) 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 @@ -2728,10 +3207,9 @@ contains !> Function for saving mesh with \b STRUCTURED_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRG_R8(cf,Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) + function VTK_GEO_STRG_R8(Nx,Ny,Nz,NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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. @@ -2739,6 +3217,7 @@ contains 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2746,6 +3225,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2755,7 +3235,7 @@ contains 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) + case(raw) 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' @@ -2769,10 +3249,9 @@ contains !> Function for saving mesh with \b STRUCTURED_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_STRG_R4(cf,Nx,Ny,Nz,NN,X,Y,Z) result(E_IO) + function VTK_GEO_STRG_R4(Nx,Ny,Nz,NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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. @@ -2780,6 +3259,7 @@ contains 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2787,6 +3267,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2796,7 +3277,7 @@ contains 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) + case(raw) 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' @@ -2810,16 +3291,16 @@ contains !> Function for saving mesh with \b RECTILINEAR_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_RECT_R8(cf,Nx,Ny,Nz,X,Y,Z) result(E_IO) + function VTK_GEO_RECT_R8(Nx,Ny,Nz,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2827,6 +3308,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2840,7 +3322,7 @@ contains 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) + case(raw) 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' @@ -2862,16 +3344,16 @@ contains !> Function for saving mesh with \b RECTILINEAR_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_RECT_R4(cf,Nx,Ny,Nz,X,Y,Z) result(E_IO) + function VTK_GEO_RECT_R4(Nx,Ny,Nz,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2879,6 +3361,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2892,7 +3375,7 @@ contains 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) + case(raw) 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' @@ -2914,14 +3397,14 @@ contains !> Function for saving mesh with \b UNSTRUCTURED_GRID topology (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_UNST_R8(cf,NN,X,Y,Z) result(E_IO) + function VTK_GEO_UNST_R8(NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -2929,6 +3412,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2937,7 +3421,7 @@ contains case(ascii) 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) + case(raw) 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) @@ -2949,14 +3433,14 @@ contains !> Function for saving mesh with \b UNSTRUCTURED_GRID topology (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_GEO_UNST_R4(cf,NN,X,Y,Z) result(E_IO) + function VTK_GEO_UNST_R4(NN,X,Y,Z,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< buffer string. integer(I4P):: rf !< Real file index. @@ -2964,6 +3448,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -2972,7 +3457,7 @@ contains case(ascii) 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) + case(raw) 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) @@ -3022,13 +3507,13 @@ 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(cf,NC,connect,cell_type) result(E_IO) + function VTK_CON(NC,connect,cell_type,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: ncon !< Dimension of connectivity vector. @@ -3036,6 +3521,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3047,7 +3533,7 @@ contains 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) + case(raw) 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 @@ -3076,18 +3562,19 @@ contains !> ... @endcode !> @return E_IO: integer(I4P) error flag !> @ingroup Lib_VTK_IOPublicProcedure - function VTK_DAT(cf,NC_NN,var_location) result(E_IO) + function VTK_DAT(NC_NN,var_location,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3100,7 +3587,7 @@ contains case('NODE') write(unit=vtk(rf)%u,fmt='(A,'//FI4P//')',iostat=E_IO)'POINT_DATA ',NC_NN endselect - case(binary) + case(raw) select case(trim(Upper_Case(var_location))) case('CELL') write(s_buffer,fmt='(A,'//FI4P//')',iostat=E_IO)'CELL_DATA ',NC_NN @@ -3118,18 +3605,19 @@ contains !> @{ !> Function for saving field of scalar variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_R8(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_R8(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3139,7 +3627,7 @@ contains 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) + case(raw) 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 @@ -3151,18 +3639,19 @@ contains !> Function for saving field of scalar variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_R4(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_R4(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3172,7 +3661,7 @@ contains 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) + case(raw) 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 @@ -3184,18 +3673,19 @@ contains !> Function for saving field of scalar variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_SCAL_I4(cf,NC_NN,varname,var) result(E_IO) + function VTK_VAR_SCAL_I4(NC_NN,varname,var,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3205,7 +3695,7 @@ contains 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) + case(raw) 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 @@ -3217,22 +3707,23 @@ contains !> Function for saving field of vectorial variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_R8(cf,vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_R8(vec_type,NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3246,7 +3737,7 @@ contains write(unit=vtk(rf)%u,fmt='(A)',iostat=E_IO)'NORMALS '//trim(varname)//' double' endselect write(unit=vtk(rf)%u,fmt='(3'//FR8P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - case(binary) + case(raw) select case(Upper_Case(trim(vec_type))) case('VECT') write(unit=vtk(rf)%u,iostat=E_IO)'VECTORS '//trim(varname)//' double'//end_rec @@ -3262,22 +3753,23 @@ contains !> Function for saving field of vectorial variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_R4(cf,vec_type,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_R4(vec_type,NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3291,7 +3783,7 @@ contains write(unit=vtk(rf)%u,fmt='(A)', iostat=E_IO)'NORMALS '//trim(varname)//' float' endselect write(unit=vtk(rf)%u,fmt='(3'//FR4P//')',iostat=E_IO)(varX(n1),varY(n1),varZ(n1),n1=1,NC_NN) - case(binary) + case(raw) select case(Upper_Case(trim(vec_type))) case('vect') write(unit=vtk(rf)%u,iostat=E_IO)'VECTORS '//trim(varname)//' float'//end_rec @@ -3307,21 +3799,22 @@ contains !> Function for saving field of vectorial variable (I4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_VECT_I4(cf,NC_NN,varname,varX,varY,varZ) result(E_IO) + function VTK_VAR_VECT_I4(NC_NN,varname,varX,varY,varZ,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. integer(I8P):: n1 !< Counter. !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3330,7 +3823,7 @@ contains case(ascii) 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) + case(raw) 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 @@ -3341,14 +3834,14 @@ contains !> Function for saving texture variable (R8P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_TEXT_R8(cf,NC_NN,dimm,varname,textCoo) result(E_IO) + function VTK_VAR_TEXT_R8(NC_NN,dimm,varname,textCoo,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -3356,6 +3849,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3366,7 +3860,7 @@ contains write(s_buffer,fmt='(I1)',iostat=E_IO)dimm s_buffer='('//trim(s_buffer)//FR4P//')' write(unit=vtk(rf)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) - case(binary) + case(raw) write(s_buffer,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' double' 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) @@ -3378,18 +3872,18 @@ contains !> Function for saving texture variable (R4P). !> @return E_IO: integer(I4P) error flag - function VTK_VAR_TEXT_R4(cf,NC_NN,dimm,varname,textCoo) result(E_IO) + function VTK_VAR_TEXT_R4(NC_NN,dimm,varname,textCoo,cf) result(E_IO) !--------------------------------------------------------------------------------------------------------------------------------- !! Function for saving texture variable (R4P). !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- implicit none - 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), 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. character(len=maxlen):: s_buffer !< Buffer string. integer(I4P):: rf !< Real file index. @@ -3397,6 +3891,7 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- + E_IO = -1_I4P rf = f if (present(cf)) then rf = cf ; f = cf @@ -3407,7 +3902,7 @@ contains write(s_buffer,fmt='(I1)',iostat=E_IO)dimm s_buffer='('//trim(s_buffer)//FR4P//')' write(unit=vtk(rf)%u,fmt=trim(s_buffer),iostat=E_IO)((textCoo(n1,n2),n2=1,dimm),n1=1,NC_NN) - case(binary) + case(raw) write(s_buffer,fmt='(A,1X,'//FI4P//',1X,A)',iostat=E_IO)'TEXTURE_COORDINATES '//trim(varname),dimm,' float' 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) @@ -3435,8 +3930,11 @@ contains !--------------------------------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------------------------------- - rf = 1 - if (present(cf)) rf = cf + E_IO = -1_I4P + rf = f + if (present(cf)) then + rf = cf ; f = cf + endif close(unit=vtk(rf)%u,iostat=E_IO) call vtk_update(act='remove',cf=rf,Nvtk=Nvtk,vtk=vtk) f = rf