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

no need to create type for native data types

This commit is contained in:
Martin Diehl 2019-04-11 12:22:16 +02:00
parent 43a59a5e9f
commit 8e295cbadf
1 changed files with 47 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/HDF5_utilities.f90
View File

@ -270,6 +270,7 @@ logical function HDF5_objectExists(loc_id,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in), optional :: path
integer :: hdferr
character(len=256) :: p
@ -298,6 +299,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel, attrValue
character(len=*), intent(in), optional :: path
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
logical :: attrExists
@ -344,8 +346,9 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
integer(HID_T) :: attr_id, space_id
logical :: attrExists
character(len=256) :: p
@ -356,27 +359,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5screate_f')
call h5tcopy_f(H5T_NATIVE_INTEGER, type_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tcopy_f')
call h5tset_size_f(type_id, 1_HSIZE_T, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tset_size_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5acreate_f')
call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5awrite_f')
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aclose_f')
call h5tclose_f(type_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tclose_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5sclose_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5sclose_f')
end subroutine HDF5_addAttribute_int
@ -390,8 +387,9 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
real(pReal), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer :: hdferr
integer(HID_T) :: attr_id, space_id, type_id
integer(HID_T) :: attr_id, space_id
logical :: attrExists
character(len=256) :: p
@ -402,27 +400,21 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5screate_f')
call h5tcopy_f(H5T_NATIVE_DOUBLE, type_id, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tcopy_f')
call h5tset_size_f(type_id, 8_HSIZE_T, hdferr) ! ToDo
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tset_size_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5screate_f')
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aexists_by_name_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f')
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5adelete_by_name_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f')
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5acreate_f')
call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5awrite_f')
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5acreate_f')
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5awrite_f')
call h5aclose_f(attr_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aclose_f')
call h5tclose_f(type_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tclose_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5tclose_f')
call h5sclose_f(space_id,hdferr)
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5sclose_f')
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5sclose_f')
end subroutine HDF5_addAttribute_real