diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-04-29 20:12:34 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-04-29 20:12:34 (GMT) |
commit | 68e4b6ef398c946b723955553f00db2fd289b8d3 (patch) | |
tree | bf063338e311f83c89bba7418499aa90e5054104 /hl/fortran | |
parent | 2fe77fad31a969fec3594339e8854e1b739b829e (diff) | |
download | hdf5-68e4b6ef398c946b723955553f00db2fd289b8d3.zip hdf5-68e4b6ef398c946b723955553f00db2fd289b8d3.tar.gz hdf5-68e4b6ef398c946b723955553f00db2fd289b8d3.tar.bz2 |
[svn-r26970] Added new pointer APIs for h5ltmake_dataset ahd h5ltread_dataset.
Diffstat (limited to 'hl/fortran')
-rw-r--r-- | hl/fortran/src/H5LTfc.c | 25 | ||||
-rw-r--r-- | hl/fortran/src/H5LTff.F90 | 156 | ||||
-rw-r--r-- | hl/fortran/src/hdf5_hl_fortrandll.def.in | 2 | ||||
-rw-r--r-- | hl/fortran/test/tstlite.f90 | 14 |
4 files changed, 172 insertions, 25 deletions
diff --git a/hl/fortran/src/H5LTfc.c b/hl/fortran/src/H5LTfc.c index b957d17..dc3c7b9 100644 --- a/hl/fortran/src/H5LTfc.c +++ b/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; diff --git a/hl/fortran/src/H5LTff.F90 b/hl/fortran/src/H5LTff.F90 index fe81ca4..8f7ad6e 100644 --- a/hl/fortran/src/H5LTff.F90 +++ b/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 @@ -300,6 +304,46 @@ CONTAINS !------------------------------------------------------------------------- !------------------------------------------------------------------------- + ! 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) ! ! Purpose: Creates and writes a dataset of a type TYPE_ID @@ -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) @@ -3414,6 +3495,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 ! ! Purpose: Reads an attribute named ATTR_NAME @@ -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 diff --git a/hl/fortran/src/hdf5_hl_fortrandll.def.in b/hl/fortran/src/hdf5_hl_fortrandll.def.in index 87276af..1b68ace 100644 --- a/hl/fortran/src/hdf5_hl_fortrandll.def.in +++ b/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 diff --git a/hl/fortran/test/tstlite.f90 b/hl/fortran/test/tstlite.f90 index 60fc659..3159367 100644 --- a/hl/fortran/test/tstlite.f90 +++ b/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 |