summaryrefslogtreecommitdiffstats
path: root/hl/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'hl/fortran')
-rw-r--r--hl/fortran/src/H5LTfc.c25
-rw-r--r--hl/fortran/src/H5LTff.F90156
-rw-r--r--hl/fortran/src/hdf5_hl_fortrandll.def.in2
-rw-r--r--hl/fortran/test/tstlite.f9014
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
generated by cgit v0.12 at 2024-11-24 23:59:21 (GMT)