223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

functions don't need acces to variables of function 

better keep them out
This commit is contained in:
Martin Diehl 2022-02-27 17:27:47 +01:00
parent 1cae6c4533
commit efa30d1f3a
1 changed files with 249 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
src/VTK.f90
View File

@ -102,12 +102,13 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
material = material + 1 material = material + 1
if (any(material<1)) call IO_error(error_ID = 844, ext_msg='material ID < 0') if (any(material<1)) call IO_error(error_ID = 844, ext_msg='material ID < 0')
contains end subroutine VTK_readVTI
!------------------------------------------------------------------------------------------------
!> @brief determine size and origin from coordinates !------------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------------ !> @brief determine size and origin from coordinates
subroutine cellsSizeOrigin(c,s,o,header) !------------------------------------------------------------------------------------------------
subroutine cellsSizeOrigin(c,s,o,header)
integer, dimension(3), intent(out) :: c integer, dimension(3), intent(out) :: c
real(pReal), dimension(3), intent(out) :: s,o real(pReal), dimension(3), intent(out) :: s,o
@ -134,13 +135,13 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
temp = getXMLValue(header,'Origin') temp = getXMLValue(header,'Origin')
o = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)] o = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)]
end subroutine end subroutine
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief Interpret Base64 string in vtk XML file as integer of default kind !> @brief Interpret Base64 string in vtk XML file as integer of default kind
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
function as_Int(base64_str,headerType,compressed,dataType) function as_Int(base64_str,headerType,compressed,dataType)
character(len=*), intent(in) :: base64_str, & ! base64 encoded string character(len=*), intent(in) :: base64_str, & ! base64 encoded string
headerType, & ! header type (UInt32 or Uint64) headerType, & ! header type (UInt32 or Uint64)
@ -149,6 +150,7 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
integer, dimension(:), allocatable :: as_Int integer, dimension(:), allocatable :: as_Int
select case(dataType) select case(dataType)
case('Int32') case('Int32')
as_Int = int(prec_bytesToC_INT32_T(asBytes(base64_str,headerType,compressed))) as_Int = int(prec_bytesToC_INT32_T(asBytes(base64_str,headerType,compressed)))
@ -162,13 +164,13 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
call IO_error(844,ext_msg='unknown data type: '//trim(dataType)) call IO_error(844,ext_msg='unknown data type: '//trim(dataType))
end select end select
end function as_Int end function as_Int
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief Interpret Base64 string in vtk XML file as integer of pReal kind !> @brief Interpret Base64 string in vtk XML file as integer of pReal kind
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
function as_pReal(base64_str,headerType,compressed,dataType) function as_pReal(base64_str,headerType,compressed,dataType)
character(len=*), intent(in) :: base64_str, & ! base64 encoded string character(len=*), intent(in) :: base64_str, & ! base64 encoded string
headerType, & ! header type (UInt32 or Uint64) headerType, & ! header type (UInt32 or Uint64)
@ -177,6 +179,7 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
real(pReal), dimension(:), allocatable :: as_pReal real(pReal), dimension(:), allocatable :: as_pReal
select case(dataType) select case(dataType)
case('Int32') case('Int32')
as_pReal = real(prec_bytesToC_INT32_T(asBytes(base64_str,headerType,compressed)),pReal) as_pReal = real(prec_bytesToC_INT32_T(asBytes(base64_str,headerType,compressed)),pReal)
@ -190,13 +193,13 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
call IO_error(844,ext_msg='unknown data type: '//trim(dataType)) call IO_error(844,ext_msg='unknown data type: '//trim(dataType))
end select end select
end function as_pReal end function as_pReal
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief Interpret Base64 string in vtk XML file as bytes !> @brief Interpret Base64 string in vtk XML file as bytes
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
function asBytes(base64_str,headerType,compressed) result(bytes) function asBytes(base64_str,headerType,compressed) result(bytes)
character(len=*), intent(in) :: base64_str, & ! base64 encoded string character(len=*), intent(in) :: base64_str, & ! base64 encoded string
headerType ! header type (UInt32 or Uint64) headerType ! header type (UInt32 or Uint64)
@ -204,30 +207,32 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes
if (compressed) then if (compressed) then
bytes = asBytes_compressed(base64_str,headerType) bytes = asBytes_compressed(base64_str,headerType)
else else
bytes = asBytes_uncompressed(base64_str,headerType) bytes = asBytes_uncompressed(base64_str,headerType)
end if end if
end function asBytes end function asBytes
!------------------------------------------------------------------------------------------------
!> @brief Interpret compressed Base64 string in vtk XML file as bytes !------------------------------------------------------------------------------------------------
!> @details A compressed Base64 string consists of a header block and a data block !> @brief Interpret compressed Base64 string in vtk XML file as bytes
! [#blocks/#u-size/#p-size/#c-size-1/#c-size-2/.../#c-size-#blocks][DATA-1/DATA-2...] !> @details A compressed Base64 string consists of a header block and a data block
! #blocks = Number of blocks ! [#blocks/#u-size/#p-size/#c-size-1/#c-size-2/.../#c-size-#blocks][DATA-1/DATA-2...]
! #u-size = Block size before compression ! #blocks = Number of blocks
! #p-size = Size of last partial block (zero if it not needed) ! #u-size = Block size before compression
! #c-size-i = Size in bytes of block i after compression ! #p-size = Size of last partial block (zero if it not needed)
!------------------------------------------------------------------------------------------------ ! #c-size-i = Size in bytes of block i after compression
function asBytes_compressed(base64_str,headerType) result(bytes) !------------------------------------------------------------------------------------------------
function asBytes_compressed(base64_str,headerType) result(bytes)
character(len=*), intent(in) :: base64_str, & ! base64 encoded string character(len=*), intent(in) :: base64_str, & ! base64 encoded string
headerType ! header type (UInt32 or Uint64) headerType ! header type (UInt32 or Uint64)
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes, bytes_inflated integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes_inflated
integer(pI64), dimension(:), allocatable :: temp, size_inflated, size_deflated integer(pI64), dimension(:), allocatable :: temp, size_inflated, size_deflated
integer(pI64) :: headerLen, nBlock, b,s,e integer(pI64) :: headerLen, nBlock, b,s,e
@ -257,23 +262,24 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
bytes(sum(size_inflated(:b-1))+1_pI64:sum(size_inflated(:b))) = zlib_inflate(bytes_inflated(s:e),size_inflated(b)) bytes(sum(size_inflated(:b-1))+1_pI64:sum(size_inflated(:b))) = zlib_inflate(bytes_inflated(s:e),size_inflated(b))
end do end do
end function asBytes_compressed end function asBytes_compressed
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief Interprete uncompressed Base64 string in vtk XML file as bytes !> @brief Interprete uncompressed Base64 string in vtk XML file as bytes
!> @details An uncompressed Base64 string consists of N headers blocks and a N data blocks !> @details An uncompressed Base64 string consists of N headers blocks and a N data blocks
![#bytes-1/DATA-1][#bytes-2/DATA-2]... ![#bytes-1/DATA-1][#bytes-2/DATA-2]...
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
function asBytes_uncompressed(base64_str,headerType) result(bytes) function asBytes_uncompressed(base64_str,headerType) result(bytes)
character(len=*), intent(in) :: base64_str, & ! base64 encoded string character(len=*), intent(in) :: base64_str, & ! base64 encoded string
headerType ! header type (UInt32 or Uint64) headerType ! header type (UInt32 or Uint64)
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes
integer(pI64) :: s integer(pI64) :: s
integer(pI64), dimension(1) :: nByte integer(pI64), dimension(1) :: nByte
integer(C_SIGNED_CHAR), dimension(:), allocatable :: bytes
allocate(bytes(0)) allocate(bytes(0))
s=0_pI64 s=0_pI64
@ -291,15 +297,15 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
end do end do
end if end if
end function asBytes_uncompressed end function asBytes_uncompressed
!------------------------------------------------------------------------------------------------
!> @brief Get XML string value for given key !------------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------------ !> @brief Get XML string value for given key.
pure function getXMLValue(line,key) !------------------------------------------------------------------------------------------------
pure function getXMLValue(line,key)
character(len=*), intent(in) :: line, key character(len=*), intent(in) :: line, key
character(len=:), allocatable :: getXMLValue character(len=:), allocatable :: getXMLValue
integer :: s,e integer :: s,e
@ -307,6 +313,7 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
character :: q character :: q
#endif #endif
s = index(line," "//key,back=.true.) s = index(line," "//key,back=.true.)
if (s==0) then if (s==0) then
getXMLValue = '' getXMLValue = ''
@ -316,7 +323,7 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
getXMLValue = '' getXMLValue = ''
else else
s = e s = e
! https://community.intel.com/t5/Intel-Fortran-Compiler/ICE-for-merge-with-strings/m-p/1207204#M151657 !https://community.intel.com/t5/Intel-Fortran-Compiler/ICE-for-merge-with-strings/m-p/1207204#M151657
#ifdef __INTEL_COMPILER #ifdef __INTEL_COMPILER
q = line(s-1:s-1) q = line(s-1:s-1)
e = s + index(line(s:),q) - 1 e = s + index(line(s:),q) - 1
@ -327,24 +334,23 @@ subroutine VTK_readVTI(cells,geomSize,origin,material, &
end if end if
end if end if
end function end function
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
!> @brief check for supported file format !> @brief Check for supported file format variants.
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
pure function fileFormatOk(line) pure function fileFormatOk(line)
character(len=*),intent(in) :: line character(len=*),intent(in) :: line
logical :: fileFormatOk logical :: fileFormatOk
fileFormatOk = getXMLValue(line,'type') == 'ImageData' .and. & fileFormatOk = getXMLValue(line,'type') == 'ImageData' .and. &
getXMLValue(line,'byte_order') == 'LittleEndian' .and. & getXMLValue(line,'byte_order') == 'LittleEndian' .and. &
getXMLValue(line,'compressor') /= 'vtkLZ4DataCompressor' .and. & getXMLValue(line,'compressor') /= 'vtkLZ4DataCompressor' .and. &
getXMLValue(line,'compressor') /= 'vtkLZMADataCompressor' getXMLValue(line,'compressor') /= 'vtkLZMADataCompressor'
end function fileFormatOk end function fileFormatOk
end subroutine VTK_readVTI
end module VTK end module VTK