mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-04-24 17:51:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r26970] Added new pointer APIs for h5ltmake_dataset ahd h5ltread_dataset.

Browse Source
This commit is contained in:
Scot Breitenfeld 2015-04-29 15:12:34 -05:00
parent 2fe77fad31
commit 68e4b6ef39
4 changed files with 172 additions and 25 deletions

25
hl/fortran/src/H5LTfc.c

@ -598,7 +598,7 @@ h5ltget_attribute_c(hid_t_f *loc_id,
_fcd dsetname,
size_t_f *attrnamelen,
_fcd attrname,
void *buf, char *dtype)
void *buf, char *dtype, size_t_f *size_f)
{
int ret_value = -1;
herr_t ret;
@ -623,20 +623,23 @@ h5ltget_attribute_c(hid_t_f *loc_id,
c_loc_id = (hid_t)*loc_id;
if( HDstrncmp(dtype,"I",1) == 0) {
if(sizeof(int_f) == sizeof(int))
ret = H5LTget_attribute_int(c_loc_id,c_name,c_attrname,(int *)buf);
else if (sizeof(int_f) == sizeof(long))
ret = H5LTget_attribute_long(c_loc_id,c_name,c_attrname,(long *)buf);
else if (sizeof(int_f) == sizeof(long long))
ret = H5LTget_attribute_long_long(c_loc_id,c_name,c_attrname,(long long *)buf);
if((size_t)*size_f == sizeof(int))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_INT,buf);
else if ((size_t)*size_f == sizeof(long))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_LONG,buf);
else if ((size_t)*size_f == sizeof(long long))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_LLONG,buf);
else
goto done;
} else if ( HDstrncmp(dtype,"R",1) == 0 ) {
ret = H5LTget_attribute_float(c_loc_id,c_name,c_attrname,(float*)buf);
} else if ( HDstrncmp(dtype,"D",1) == 0 ) {
ret = H5LTget_attribute_double(c_loc_id,c_name,c_attrname,(double *)buf);
if((size_t)*size_f == sizeof(float))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_FLOAT,buf);
else if((size_t)*size_f == sizeof(double))
ret = H5LTget_attribute(c_loc_id,c_name,c_attrname,H5T_NATIVE_DOUBLE,buf);
else
goto done;
}
if (ret < 0)
goto done;

156
hl/fortran/src/H5LTff.F90

@ -30,7 +30,8 @@
! This is needed for Windows based operating systems.
!
#include "H5config_f.inc"
#include <H5config_f.inc>
MODULE h5lt
USE, INTRINSIC :: ISO_C_BINDING
USE h5fortran_types
@ -67,6 +68,7 @@ MODULE h5lt
MODULE PROCEDURE h5ltmake_dataset_f_c_long_double6
MODULE PROCEDURE h5ltmake_dataset_f_c_long_double7
#endif
MODULE PROCEDURE h5ltmake_dataset_f_ptr
END INTERFACE
INTERFACE h5ltread_dataset_f
@ -100,6 +102,7 @@ MODULE h5lt
MODULE PROCEDURE h5ltread_dataset_f_c_long_double6
MODULE PROCEDURE h5ltread_dataset_f_c_long_double7
#endif
MODULE PROCEDURE h5ltread_dataset_f_ptr
END INTERFACE
INTERFACE h5ltmake_dataset_int_f
@ -277,7 +280,7 @@ MODULE h5lt
END INTERFACE
INTERFACE
INTEGER FUNCTION h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,dtype) &
INTEGER FUNCTION h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,dtype, SizeOf) &
BIND(C,NAME='h5ltget_attribute_c')
IMPORT :: C_CHAR, C_PTR
IMPORT :: HID_T, SIZE_T, HSIZE_T
@ -290,7 +293,8 @@ MODULE h5lt
TYPE(C_PTR), VALUE :: buf ! data buffer
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: dtype ! flag indicating the datatype of the
! the buffer:
! R=Real, D=DOUBLE, I=Interger, C=Character
! R=Real, D=DOUBLE, I=Interger
INTEGER(size_t) :: SizeOf ! Sizeof the buf datatype
END FUNCTION h5ltget_attribute_c
END INTERFACE
@ -299,6 +303,46 @@ CONTAINS
! Make/Read dataset functions
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
! Function(s): h5ltmake_dataset_f_ptr
!
! Purpose: Creates and writes a dataset of a type TYPE_ID
!
! Return: Success: 0, Failure: -1
!
! Programmer: M. Scot Breitenfeld
!
! Date: APR 29, 2015
!
! Comments:
!
! Modifications:
!
!-------------------------------------------------------------------------
SUBROUTINE h5ltmake_dataset_f_ptr(loc_id,&
dset_name,&
rank,&
dims,&
type_id,&
buf,&
errcode )
IMPLICIT NONE
INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
CHARACTER(len=*), INTENT(in) :: dset_name ! name of the dataset
INTEGER, INTENT(in) :: rank ! rank
INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims ! size of the buffer buf
INTEGER(hid_t), INTENT(in) :: type_id ! datatype identifier
TYPE(C_PTR) :: buf ! data buffer
INTEGER :: errcode ! error code
INTEGER(size_t) :: namelen ! name length
namelen = LEN(dset_name)
errcode = h5ltmake_dataset_c(loc_id,namelen,dset_name,rank,dims,type_id,buf)
END SUBROUTINE h5ltmake_dataset_f_ptr
!-------------------------------------------------------------------------
! Function(s): h5ltmake_dataset_f_int(1-7)
!
@ -1027,6 +1071,43 @@ CONTAINS
END SUBROUTINE h5ltmake_dataset_f_c_long_double7
#endif
!-------------------------------------------------------------------------
! Function(s): h5ltread_dataset_f_ptr
!
! Purpose: Read a dataset of a type TYPE_ID
!
! Return: Success: 0, Failure: -1
!
! Programmer: M. Scot Breitenfeld
!
! Date: Apr 29, 2015
!
! Comments:
!
! Modifications:
!
!-------------------------------------------------------------------------
SUBROUTINE h5ltread_dataset_f_ptr(loc_id,&
dset_name,&
type_id,&
buf,&
dims,&
errcode )
IMPLICIT NONE
INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset
INTEGER(hid_t), INTENT(in) :: type_id ! datatype identifier
INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims ! size of the buffer buf
TYPE(C_PTR) :: buf ! data buffer
INTEGER :: errcode ! error code
INTEGER(size_t) :: namelen
namelen = LEN(dset_name)
errcode = h5ltread_dataset_c(loc_id,namelen,dset_name,type_id, buf, dims)
END SUBROUTINE h5ltread_dataset_f_ptr
!-------------------------------------------------------------------------
! Function(s): h5ltread_dataset_f_int(1-7)
@ -3413,6 +3494,44 @@ CONTAINS
END SUBROUTINE h5ltset_attribute_string_f
!-------------------------------------------------------------------------
! Function: h5ltget_attribute_f
!
! Purpose: Reads an attribute named ATTR_NAME
!
! Return: Success: 0, Failure: -1
!
! Programmer: M. Scot Breitenfeld
!
! Date: Apr 29, 2015
!
! Comments:
!
! Modifications:
!
!-------------------------------------------------------------------------
!!$ SUBROUTINE h5ltget_attribute_f(loc_id,&
!!$ dset_name,&
!!$ attr_name,&
!!$ buf,&
!!$ errcode )
!!$
!!$ IMPLICIT NONE
!!$ INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
!!$ CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset
!!$ CHARACTER(LEN=*), INTENT(in) :: attr_name ! name of the attribute
!!$ INTEGER :: errcode ! error code
!!$ TYPE(C_PTR) :: buf! data buffer
!!$ INTEGER(size_t) :: namelen ! name length
!!$ INTEGER(size_t) :: attrlen ! name length
!!$
!!$ namelen = LEN(dset_name)
!!$ attrlen = LEN(attr_name)
!!$ errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,buf,'I'//C_NULL_CHAR)
!!$
!!$ END SUBROUTINE h5ltget_attribute_f
!-------------------------------------------------------------------------
! Function: h5ltget_attribute_int_f
!
@ -3445,16 +3564,21 @@ CONTAINS
INTEGER(size_t) :: namelen ! name length
INTEGER(size_t) :: attrlen ! name length
TYPE(C_PTR) :: f_ptr
INTEGER(size_t) :: SizeOf
f_ptr = C_LOC(buf(1))
f_ptr = C_LOC(buf(1))
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
SizeOf = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
SizeOf = SIZEOF(buf(1))
#endif
namelen = LEN(dset_name)
attrlen = LEN(attr_name)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'I'//C_NULL_CHAR)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'I'//C_NULL_CHAR, SizeOf)
END SUBROUTINE h5ltget_attribute_int_f
!-------------------------------------------------------------------------
! Function: h5ltget_attribute_float_f
!
@ -3487,12 +3611,17 @@ CONTAINS
INTEGER(size_t) :: namelen ! name length
INTEGER(size_t) :: attrlen ! name length
TYPE(C_PTR) :: f_ptr
INTEGER(size_t) :: SizeOf
f_ptr = C_LOC(buf(1))
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
SizeOf = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
SizeOf = SIZEOF(buf(1))
#endif
namelen = LEN(dset_name)
attrlen = LEN(attr_name)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'R'//C_NULL_CHAR)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'R'//C_NULL_CHAR, SizeOf)
END SUBROUTINE h5ltget_attribute_float_f
@ -3528,12 +3657,19 @@ CONTAINS
INTEGER(size_t) :: namelen ! name length
INTEGER(size_t) :: attrlen ! name length
TYPE(C_PTR) :: f_ptr
INTEGER(size_t) :: SizeOf
f_ptr = C_LOC(buf(1))
f_ptr = C_LOC(buf(1))
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
SizeOf = STORAGE_SIZE(buf(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
SizeOf = SIZEOF(buf(1))
#endif
namelen = LEN(dset_name)
attrlen = LEN(attr_name)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'D'//C_NULL_CHAR)
errcode = h5ltget_attribute_c(loc_id,namelen,dset_name,attrlen,attr_name,f_ptr,'R'//C_NULL_CHAR, SizeOf)
END SUBROUTINE h5ltget_attribute_double_f

2
hl/fortran/src/hdf5_hl_fortrandll.def.in

@ -23,6 +23,7 @@ H5I_mp_H5IMGET_PALETTE_INFO_F
H5I_mp_H5IMGET_PALETTE_F
H5I_mp_H5IMIS_PALETTE_F
; H5LT
H5LT_mp_H5LTMAKE_DATASET_F_PTR
H5LT_mp_H5LTMAKE_DATASET_F_INT1
H5LT_mp_H5LTMAKE_DATASET_F_INT2
H5LT_mp_H5LTMAKE_DATASET_F_INT3
@ -51,6 +52,7 @@ H5LT_mp_H5LTMAKE_DATASET_F_C_LONG_DOUBLE4
H5LT_mp_H5LTMAKE_DATASET_F_C_LONG_DOUBLE5
H5LT_mp_H5LTMAKE_DATASET_F_C_LONG_DOUBLE6
H5LT_mp_H5LTMAKE_DATASET_F_C_LONG_DOUBLE7
H5LT_mp_H5LTREAD_DATASET_F_PTR
H5LT_mp_H5LTREAD_DATASET_F_INT1
H5LT_mp_H5LTREAD_DATASET_F_INT2
H5LT_mp_H5LTREAD_DATASET_F_INT3

14
hl/fortran/test/tstlite.f90

@ -578,6 +578,7 @@ END SUBROUTINE test_dataset3D
SUBROUTINE test_datasetND(rank)
USE, INTRINSIC :: ISO_C_BINDING
USE H5LT ! module of H5LT
USE HDF5 ! module of HDF5 library
@ -628,6 +629,7 @@ SUBROUTINE test_datasetND(rank)
INTEGER :: type_class
INTEGER(SIZE_T) :: type_size
CHARACTER(LEN=1) :: ichr1
TYPE(C_PTR) :: f_ptr
WRITE(ichr1,'(I1.1)') rank
CALL test_begin(' Make/Read datasets ('//ichr1//'D) ')
@ -768,7 +770,8 @@ SUBROUTINE test_datasetND(rank)
IF(rank.EQ.4)THEN
CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_4, errcode)
ELSE IF(rank.EQ.5)THEN
CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_5, errcode)
f_ptr = C_LOC(ibuf_5(1,1,1,1,1))
CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, f_ptr, errcode)
ELSE IF(rank.EQ.6)THEN
CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_6, errcode)
ELSE IF(rank.EQ.7)THEN
@ -782,7 +785,8 @@ SUBROUTINE test_datasetND(rank)
IF(rank.EQ.4)THEN
CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_4, dims(1:rank), errcode)
ELSE IF(rank.EQ.5)THEN
CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_5, dims(1:rank), errcode)
f_ptr = C_LOC(ibufr_5(1,1,1,1,1))
CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, f_ptr, dims(1:rank), errcode)
ELSE IF(rank.EQ.6)THEN
CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_6, dims(1:rank), errcode)
ELSE IF(rank.EQ.7)THEN
@ -844,7 +848,8 @@ SUBROUTINE test_datasetND(rank)
IF(rank.EQ.4)THEN
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_4, errcode)
ELSE IF(rank.EQ.5)THEN
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_5, errcode)
f_ptr = C_LOC(rbuf_5(1,1,1,1,1))
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode)
ELSE IF(rank.EQ.6)THEN
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_6, errcode)
ELSE IF(rank.EQ.7)THEN
@ -858,7 +863,8 @@ SUBROUTINE test_datasetND(rank)
IF(rank.EQ.4)THEN
CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, rbufr_4, dims(1:rank), errcode)
ELSE IF(rank.EQ.5)THEN
CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, rbufr_5, dims(1:rank), errcode)
f_ptr = C_LOC(rbufr_5(1,1,1,1,1))
CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, dims(1:rank), errcode)
ELSE IF(rank.EQ.6)THEN
CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, rbufr_6, dims(1:rank), errcode)
ELSE IF(rank.EQ.7)THEN