summaryrefslogtreecommitdiffstats
path: root/hl
diff options
context:
space:
mode:
authorMohamad Chaarawi <chaarawi@hdfgroup.org>2016-04-15 16:11:52 (GMT)
committerMohamad Chaarawi <chaarawi@hdfgroup.org>2016-04-15 16:11:52 (GMT)
commit88dbe657cf1e0975e7a837b90d39e11566f7bfb3 (patch)
tree002c2e760ae699e17203b7f9f79019a3fb84bc6e /hl
parent257689f6b4511ed3031d08d638550aa2e864d294 (diff)
parent18e360b9fa7fdce30a25d62a7139b9e69c56bf01 (diff)
downloadhdf5-inactive/multi_rd_wd_coll_io.zip
hdf5-inactive/multi_rd_wd_coll_io.tar.gz
hdf5-inactive/multi_rd_wd_coll_io.tar.bz2
[svn-r29709] another merge from trunk.inactive/multi_rd_wd_coll_io
Diffstat (limited to 'hl')
-rw-r--r--hl/fortran/src/H5LTf90proto.h32
-rw-r--r--hl/fortran/src/H5LTff.F9028
-rw-r--r--hl/fortran/src/H5TBfc.c276
-rw-r--r--hl/fortran/src/H5TBff.F90182
-rw-r--r--hl/fortran/src/hdf5_hl_fortrandll.def.in4
-rw-r--r--hl/fortran/test/Makefile.am2
-rw-r--r--hl/fortran/test/tstlite.F9076
-rw-r--r--hl/fortran/test/tsttable.F90242
-rw-r--r--hl/test/test_lite.c23
9 files changed, 726 insertions, 139 deletions
diff --git a/hl/fortran/src/H5LTf90proto.h b/hl/fortran/src/H5LTf90proto.h
index 20d043e..77f941e 100644
--- a/hl/fortran/src/H5LTf90proto.h
+++ b/hl/fortran/src/H5LTf90proto.h
@@ -311,6 +311,38 @@ h5tbmake_table_c(size_t_f *namelen1,
HDF5_HL_F90CSTUBDLL
int_f
+h5tbread_table_c(hid_t_f *loc_id,
+ _fcd name,
+ size_t_f *namelen,
+ hsize_t_f *nfields,
+ size_t_f *dst_size,
+ size_t_f *dst_offset,
+ size_t_f *dst_sizes,
+ void *dst_buf);
+
+
+HDF5_HL_F90CSTUBDLL
+int_f
+h5tbmake_table_ptr_c(size_t_f *namelen1,
+ _fcd name1,
+ hid_t_f *loc_id,
+ size_t_f *namelen,
+ _fcd name,
+ hsize_t_f *nfields,
+ hsize_t_f *nrecords,
+ size_t_f *type_size,
+ size_t_f *field_offset,
+ hid_t_f *field_types,
+ hsize_t_f *chunk_size,
+ void *fill_data,
+ int_f *compress,
+ size_t_f *char_len_field_names, /* field_names lenghts */
+ size_t_f *max_char_size_field_names, /* char len of fields */
+ char *field_names, /* field_names */
+ void *data);
+
+HDF5_HL_F90CSTUBDLL
+int_f
h5tbwrite_field_name_c(hid_t_f *loc_id,
size_t_f *namelen,
_fcd name,
diff --git a/hl/fortran/src/H5LTff.F90 b/hl/fortran/src/H5LTff.F90
index d36d92c..18c36f0 100644
--- a/hl/fortran/src/H5LTff.F90
+++ b/hl/fortran/src/H5LTff.F90
@@ -110,7 +110,7 @@ MODULE H5LT_CONST
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: dtype ! flag indicating the datatype of the
! the buffer:
! R=Real, D=DOUBLE, I=Interger
- INTEGER(size_t) :: SizeOf_buf ! Sizeof the buf datatype
+ INTEGER(size_t), INTENT(in) :: SizeOf_buf ! Sizeof the buf data type
END FUNCTION h5ltget_attribute_c
END INTERFACE
@@ -1059,14 +1059,16 @@ CONTAINS
CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset
CHARACTER(LEN=*), INTENT(in) :: attr_name ! name of the attribute
TYPE(C_PTR) :: buf ! data buffer
- CHARACTER(LEN=*), INTENT(in) :: buf_type !
+ CHARACTER(LEN=*), INTENT(in) :: buf_type ! valid data types are:
+ ! CHARACTER, INTEGER or REAL
+ ! NOTE: only the first character matters and is case insensitive
INTEGER(size_t), INTENT(in) :: size ! size of attribute array
- INTEGER :: errcode ! error code
- INTEGER(size_t) :: namelen ! name length
- INTEGER(size_t) :: attrlen ! name length
+ INTEGER(size_t), INTENT(in) :: SizeOf_buf_type ! size of buf's data type
+ INTEGER, INTENT(out) :: errcode ! error code
- CHARACTER(KIND=C_CHAR) :: buf_type_uppercase
- INTEGER(size_t) :: SizeOf_buf_type
+ INTEGER(size_t) :: namelen ! name length
+ INTEGER(size_t) :: attrlen ! name length
+ CHARACTER(KIND=C_CHAR) :: buf_type_uppercase
namelen = LEN(dset_name)
attrlen = LEN(attr_name)
@@ -1316,13 +1318,15 @@ CONTAINS
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, INTENT(out) :: errcode ! error code
- CHARACTER(LEN=*), INTENT(in) :: buf_type
- TYPE(C_PTR) :: buf! data buffer
+ TYPE(C_PTR) :: buf ! data buffer
+ CHARACTER(LEN=*), INTENT(in) :: buf_type ! valid data types are:
+ ! CHARACTER, INTEGER or REAL
+ ! NOTE: only the first character matters and is case insensitive
+ INTEGER(size_t), INTENT(in) :: SizeOf_buf_type ! size of buf's data type
+ INTEGER, INTENT(out) :: errcode ! error code
INTEGER(size_t) :: namelen ! name length
- INTEGER(size_t) :: attrlen ! name length
+ INTEGER(size_t) :: attrlen ! attr length
CHARACTER(KIND=C_CHAR) :: buf_type_uppercase
- INTEGER(size_t) :: SizeOf_buf_type
namelen = LEN(dset_name)
attrlen = LEN(attr_name)
diff --git a/hl/fortran/src/H5TBfc.c b/hl/fortran/src/H5TBfc.c
index 99a7800..2bb7c3b 100644
--- a/hl/fortran/src/H5TBfc.c
+++ b/hl/fortran/src/H5TBfc.c
@@ -37,21 +37,12 @@
*-------------------------------------------------------------------------
*/
int_f
-h5tbmake_table_c(size_t_f *namelen1,
- _fcd name1,
- hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- hsize_t_f *nfields,
- hsize_t_f *nrecords,
- size_t_f *type_size,
- size_t_f *field_offset,
- hid_t_f *field_types,
- hsize_t_f *chunk_size,
- int_f *compress,
- size_t_f *char_len_field_names, /* field_names lenghts */
- size_t_f *max_char_size_field_names, /* char len of fields */
- char *field_names) /* field_names */
+h5tbmake_table_c(size_t_f *namelen1, _fcd name1, hid_t_f *loc_id, size_t_f *namelen, _fcd name,
+ hsize_t_f *nfields, hsize_t_f *nrecords, size_t_f *type_size, size_t_f *field_offset,
+ hid_t_f *field_types, hsize_t_f *chunk_size, int_f *compress,
+ size_t_f *char_len_field_names, /* field_names lenghts */
+ size_t_f *max_char_size_field_names, /* char len of fields */
+ char *field_names) /* field_names */
{
char *c_name = NULL;
char *c_name1 = NULL;
@@ -101,7 +92,6 @@ h5tbmake_table_c(size_t_f *namelen1,
HGOTO_DONE(FAIL)
HDmemcpy(c_field_names[i], tmp_p, (size_t)char_len_field_names[i]);
c_field_names[i][char_len_field_names[i]] = '\0';
-
tmp_p = tmp_p + *max_char_size_field_names;
} /* end for */
@@ -136,6 +126,177 @@ done:
} /* end h5tbmake_table_c() */
/*-------------------------------------------------------------------------
+* Function: h5tbmake_table_ptr_c
+*
+* Purpose: Call H5TBmake_table using F2003 features
+*
+* Return: Success: 0, Failure: -1
+*
+* Programmer: M. Scot Breitenfeld
+*
+* Date: Sept. 10, 2015
+*
+* Comments:
+*
+*-------------------------------------------------------------------------
+*/
+int_f
+h5tbmake_table_ptr_c(size_t_f *namelen1, _fcd name1, hid_t_f *loc_id, size_t_f *namelen,
+ _fcd name, hsize_t_f *nfields, hsize_t_f *nrecords, size_t_f *type_size,
+ size_t_f *field_offset, hid_t_f *field_types, hsize_t_f *chunk_size,
+ void *fill_data, int_f *compress,
+ size_t_f *char_len_field_names, /* field_names lenghts */
+ size_t_f *max_char_size_field_names, /* char len of fields */
+ char *field_names,
+ void *data) /* field_names */
+{
+ char *c_name = NULL;
+ char *c_name1 = NULL;
+ hsize_t num_elem;
+ hsize_t i;
+ hsize_t c_nfields = (hsize_t)*nfields;
+ size_t *c_field_offset = NULL;
+ hid_t *c_field_types = NULL;
+ char **c_field_names = NULL;
+ char *tmp = NULL, *tmp_p;
+ int_f ret_value = 0;
+
+ num_elem = (hsize_t)*nfields;
+
+ /*
+ * convert FORTRAN name to C name
+ */
+ if(NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen)))
+ HGOTO_DONE(FAIL)
+ if(NULL == (c_name1 = (char *)HD5f2cstring(name1, (size_t)*namelen1)))
+ HGOTO_DONE(FAIL)
+ if(NULL == (c_field_offset = (size_t *)HDmalloc(sizeof(size_t) * (size_t)c_nfields)))
+ HGOTO_DONE(FAIL)
+ if(NULL == (c_field_types = (hid_t *)HDmalloc(sizeof(hid_t) * (size_t)c_nfields)))
+ HGOTO_DONE(FAIL)
+
+ for(i = 0; i < num_elem; i++) {
+ c_field_offset[i] = (size_t)field_offset[i];
+ c_field_types[i] = field_types[i];
+ } /* end for */
+
+ /*
+ * allocate array of character pointers
+ */
+ if(NULL == (c_field_names = (char **)HDcalloc((size_t)num_elem, sizeof(char *))))
+ HGOTO_DONE(FAIL)
+
+ /* copy data to long C string */
+ if(NULL == (tmp = (char *)HD5f2cstring(field_names, (size_t)*(max_char_size_field_names)*(size_t)num_elem)))
+ HGOTO_DONE(FAIL)
+ /*
+ * move data from temorary buffer
+ */
+ tmp_p = tmp;
+ for(i = 0; i < num_elem; i++) {
+ if(NULL == (c_field_names[i] = (char *)HDmalloc((size_t)char_len_field_names[i] + 1)))
+ HGOTO_DONE(FAIL)
+ HDmemcpy(c_field_names[i], tmp_p, (size_t)char_len_field_names[i]);
+ c_field_names[i][char_len_field_names[i]] = '\0';
+ tmp_p = tmp_p + *max_char_size_field_names;
+ } /* end for */
+
+ /*
+ * call H5TBmake_table function.
+ */
+ if(H5TBmake_table(c_name1, (hid_t)*loc_id, c_name, c_nfields, (hsize_t)*nrecords,
+ (size_t)*type_size, (const char **)c_field_names, c_field_offset, c_field_types,
+ (hsize_t)*chunk_size, fill_data, *compress, data) < 0)
+ HGOTO_DONE(FAIL)
+
+done:
+ if(c_name)
+ HDfree(c_name);
+ if(c_name1)
+ HDfree(c_name1);
+ if(c_field_names) {
+ for(i = 0; i < num_elem; i++) {
+ if(c_field_names[i])
+ HDfree(c_field_names[i]);
+ } /* end for */
+ HDfree(c_field_names);
+ } /* end if */
+ if(tmp)
+ HDfree(tmp);
+ if(c_field_offset)
+ HDfree(c_field_offset);
+ if(c_field_types)
+ HDfree(c_field_types);
+
+ return ret_value;
+} /* end h5tbmake_table_c() */
+
+
+/*-------------------------------------------------------------------------
+* Function: h5tbread_table_c
+*
+* Purpose: Call H5TBread_table using F2003 features
+*
+* Return: Success: 0, Failure: -1
+*
+* Programmer: M. Scot Breitenfeld
+*
+* Date: Sept. 14, 2015
+*
+* Comments:
+*
+*-------------------------------------------------------------------------
+*/
+int_f
+h5tbread_table_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hsize_t_f *nfields,
+ size_t_f *dst_size, size_t_f *dst_offset, size_t_f *dst_sizes, void *dst_buf)
+{
+ char *c_name = NULL;
+ size_t *c_dst_offset = NULL;
+ size_t *c_dst_sizes = NULL;
+ hsize_t c_nfields = (hsize_t)*nfields;
+ int_f ret_value = 0;
+ hsize_t i;
+
+ /*
+ * convert FORTRAN name to C name
+ */
+ if(NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen)))
+ HGOTO_DONE(FAIL)
+
+ if(NULL == (c_dst_offset = (size_t *)HDmalloc(sizeof(size_t) * (size_t)c_nfields)))
+ HGOTO_DONE(FAIL)
+ if(NULL == (c_dst_sizes = (size_t *)HDmalloc(sizeof(size_t) * (size_t)c_nfields)))
+ HGOTO_DONE(FAIL)
+
+ for(i = 0; i < c_nfields; i++) {
+ c_dst_offset[i] = (size_t)dst_offset[i];
+ c_dst_sizes[i] = (size_t)dst_sizes[i];
+ } /* end for */
+
+ /*
+ * call H5TBread_table function.
+ */
+ if(H5TBread_table( (hid_t)*loc_id, c_name, (size_t)*dst_size, c_dst_offset,
+ c_dst_sizes, dst_buf) < 0)
+ HGOTO_DONE(FAIL)
+
+done:
+ if(c_name)
+ HDfree(c_name);
+
+ if(c_dst_offset)
+ HDfree(c_dst_offset);
+ if(c_dst_sizes)
+ HDfree(c_dst_sizes);
+
+ return ret_value;
+} /* end h5tbmake_table_c() */
+
+
+
+
+/*-------------------------------------------------------------------------
* Function: h5tbwrite_field_name_c
*
* Purpose: Call H5TBwrite_fields_name
@@ -151,15 +312,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbwrite_field_name_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- size_t_f *namelen1,
- _fcd field_name,
- hsize_t_f *start,
- hsize_t_f *nrecords,
- size_t_f *type_size,
- void *buf)
+h5tbwrite_field_name_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, size_t_f *namelen1, _fcd field_name,
+ hsize_t_f *start, hsize_t_f *nrecords, size_t_f *type_size, void *buf)
{
char *c_name = NULL;
char *c_name1 = NULL;
@@ -207,15 +361,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbread_field_name_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- size_t_f *namelen1,
- _fcd field_name,
- hsize_t_f *start,
- hsize_t_f *nrecords,
- size_t_f *type_size,
- void *buf)
+h5tbread_field_name_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, size_t_f *namelen1, _fcd field_name,
+ hsize_t_f *start, hsize_t_f *nrecords, size_t_f *type_size, void *buf)
{
char *c_name = NULL;
char *c_name1 = NULL;
@@ -262,14 +409,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbwrite_field_index_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- int_f *field_index,
- hsize_t_f *start,
- hsize_t_f *nrecords,
- size_t_f *type_size,
- void *buf)
+h5tbwrite_field_index_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, int_f *field_index, hsize_t_f *start,
+ hsize_t_f *nrecords, size_t_f *type_size, void *buf)
{
char *c_name = NULL;
size_t c_type_size = *type_size;
@@ -313,14 +454,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbread_field_index_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- int_f *field_index,
- hsize_t_f *start,
- hsize_t_f *nrecords,
- size_t_f *type_size,
- void *buf)
+h5tbread_field_index_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, int_f *field_index, hsize_t_f *start,
+ hsize_t_f *nrecords, size_t_f *type_size, void *buf)
{
char *c_name = NULL;
size_t c_type_size = *type_size;
@@ -363,14 +498,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbinsert_field_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- size_t_f *namelen1,
- _fcd field_name,
- hid_t_f *field_type,
- int_f *position,
- void *buf)
+h5tbinsert_field_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, size_t_f *namelen1,
+ _fcd field_name, hid_t_f *field_type, int_f *position, void *buf)
{
char *c_name = NULL;
char *c_name1 = NULL;
@@ -416,11 +545,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbdelete_field_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- size_t_f *namelen1,
- _fcd field_name)
+h5tbdelete_field_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name,
+ size_t_f *namelen1, _fcd field_name)
{
char *c_name = NULL;
char *c_name1 = NULL;
@@ -465,11 +591,8 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbget_table_info_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- hsize_t_f *nfields,
- hsize_t_f *nrecords)
+h5tbget_table_info_c(hid_t_f *loc_id, size_t_f *namelen,
+ _fcd name, hsize_t_f *nfields, hsize_t_f *nrecords)
{
char *c_name = NULL;
hsize_t c_nfields;
@@ -515,17 +638,12 @@ done:
*-------------------------------------------------------------------------
*/
int_f
-h5tbget_field_info_c(hid_t_f *loc_id,
- size_t_f *namelen,
- _fcd name,
- hsize_t_f *nfields,
- size_t_f *field_sizes,
- size_t_f *field_offsets,
- size_t_f *type_size,
- size_t_f *namelen2, /* field_names lenghts */
- size_t_f *lenmax, /* character len max */
- _fcd field_names, /* field_names */
- size_t_f *maxlen_out)
+h5tbget_field_info_c(hid_t_f *loc_id, size_t_f *namelen, _fcd name, hsize_t_f *nfields,
+ size_t_f *field_sizes, size_t_f *field_offsets, size_t_f *type_size,
+ size_t_f *namelen2, /* field_names lenghts */
+ size_t_f *lenmax, /* character len max */
+ _fcd field_names, /* field_names */
+ size_t_f *maxlen_out)
{
char *c_name = NULL;
diff --git a/hl/fortran/src/H5TBff.F90 b/hl/fortran/src/H5TBff.F90
index 448d607..266f74a 100644
--- a/hl/fortran/src/H5TBff.F90
+++ b/hl/fortran/src/H5TBff.F90
@@ -63,6 +63,11 @@ MODULE h5tb_CONST
MODULE PROCEDURE h5tbinsert_field_f_string
END INTERFACE
+ INTERFACE h5tbmake_table_f
+ MODULE PROCEDURE h5tbmake_table_f90
+ MODULE PROCEDURE h5tbmake_table_ptr_f
+ END INTERFACE
+
INTERFACE
INTEGER FUNCTION h5tbwrite_field_name_c(loc_id,namelen,dset_name,namelen1,field_name,&
start,nrecords,type_size,buf) &
@@ -163,7 +168,7 @@ MODULE h5tb_CONST
CONTAINS
!-------------------------------------------------------------------------
-! Function: h5tbmake_table_f
+! Function: h5tbmake_table_f90
!
! Purpose: Make a table
!
@@ -179,7 +184,7 @@ CONTAINS
!
!-------------------------------------------------------------------------
- SUBROUTINE h5tbmake_table_f(table_title,&
+ SUBROUTINE h5tbmake_table_f90(table_title,&
loc_id,&
dset_name,&
nfields,&
@@ -259,23 +264,162 @@ CONTAINS
max_char_size_field_names = LEN(field_names(1))
- errcode = h5tbmake_table_c(namelen1,&
- table_title,&
- loc_id,&
- namelen,&
- dset_name,&
- nfields,&
- nrecords,&
- type_size,&
- field_offset,&
- field_types,&
- chunk_size,&
- compress,&
- char_len_field_names, &
- max_char_size_field_names, &
- field_names)
-
- END SUBROUTINE h5tbmake_table_f
+ errcode = h5tbmake_table_c(namelen1, table_title, loc_id, namelen, dset_name, nfields, nrecords,&
+ type_size, field_offset, field_types, chunk_size, compress, char_len_field_names, &
+ max_char_size_field_names, field_names)
+
+ END SUBROUTINE h5tbmake_table_f90
+
+ SUBROUTINE h5tbmake_table_ptr_f(table_title,&
+ loc_id,&
+ dset_name,&
+ nfields,&
+ nrecords,&
+ type_size,&
+ field_names,&
+ field_offset,&
+ field_types,&
+ chunk_size,&
+ fill_data,&
+ compress,&
+ data,&
+ errcode )
+
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(in) :: table_title ! name of the dataset
+ INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
+ CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset
+ INTEGER(hsize_t), INTENT(in) :: nfields ! fields
+ INTEGER(hsize_t), INTENT(in) :: nrecords ! records
+ INTEGER(size_t), INTENT(in) :: type_size ! type size
+ CHARACTER(LEN=*), DIMENSION(1:nfields), INTENT(in) :: field_names ! field names
+ INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: field_offset ! field offset
+ INTEGER(hid_t), DIMENSION(1:nfields), INTENT(in) :: field_types ! field types
+ INTEGER(hsize_t), INTENT(in) :: chunk_size ! chunk size
+ TYPE(C_PTR), INTENT(in) :: fill_data ! Fill values data
+ INTEGER, INTENT(in) :: compress ! compress
+ TYPE(C_PTR), INTENT(in) :: data ! Buffer with data to be written to the table
+ INTEGER(size_t) :: namelen ! name length
+ INTEGER(size_t) :: namelen1 ! name length
+ INTEGER :: errcode ! error code
+ INTEGER(size_t), DIMENSION(1:nfields) :: char_len_field_names ! field name lengths
+ INTEGER(size_t) :: max_char_size_field_names ! character len of field names
+ INTEGER(hsize_t) :: i ! general purpose integer
+
+ INTERFACE
+ INTEGER FUNCTION h5tbmake_table_ptr_c(namelen1,&
+ table_title,&
+ loc_id,&
+ namelen,&
+ dset_name,&
+ nfields,&
+ nrecords,&
+ type_size,&
+ field_offset,&
+ field_types,&
+ chunk_size,&
+ fill_data,&
+ compress,&
+ char_len_field_names,&
+ max_char_size_field_names,&
+ field_names,&
+ data) &
+ BIND(C,NAME='h5tbmake_table_ptr_c')
+ IMPORT :: C_CHAR, C_PTR
+ IMPORT :: HID_T, SIZE_T, HSIZE_T
+ IMPLICIT NONE
+ CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: table_title ! name of the dataset
+ INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
+ CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(in) :: dset_name ! name of the dataset
+ INTEGER(hsize_t), INTENT(in) :: nfields ! fields
+ INTEGER(hsize_t), INTENT(in) :: nrecords ! records
+ INTEGER(size_t), INTENT(in) :: type_size ! type size
+ CHARACTER(KIND=C_CHAR), DIMENSION(nfields), INTENT(in) :: field_names ! field names
+ INTEGER(size_t), DIMENSION(nfields), INTENT(in) :: field_offset ! field offset
+ INTEGER(hid_t), DIMENSION(nfields), INTENT(in) :: field_types ! field types
+ INTEGER(hsize_t), INTENT(in) :: chunk_size ! chunk size
+ TYPE(C_PTR), INTENT(in), VALUE :: fill_data ! Fill values data
+ INTEGER, INTENT(in) :: compress ! compress
+ INTEGER(size_t) :: namelen ! name length
+ INTEGER(size_t) :: namelen1 ! name length
+ INTEGER(size_t), DIMENSION(nfields) :: char_len_field_names ! field name's lengths
+ INTEGER(size_t) :: max_char_size_field_names ! character len of field names
+ TYPE(C_PTR), INTENT(in), VALUE :: data
+ END FUNCTION h5tbmake_table_ptr_c
+ END INTERFACE
+
+ namelen = LEN(dset_name)
+ namelen1 = LEN(table_title)
+
+ ! Find the size of each character string in the array
+ DO i = 1, nfields
+ char_len_field_names(i) = LEN_TRIM(field_names(i))
+ END DO
+
+ max_char_size_field_names = LEN(field_names(1))
+
+ errcode = h5tbmake_table_ptr_c(namelen1, table_title, loc_id, namelen, dset_name, nfields, nrecords,&
+ type_size, field_offset, field_types, chunk_size, fill_data, compress, char_len_field_names, &
+ max_char_size_field_names, field_names, data)
+
+ END SUBROUTINE h5tbmake_table_ptr_f
+
+ SUBROUTINE h5tbread_table_f(loc_id, table_name, nfields, dst_size, dst_offset, &
+ dst_sizes, dst_buf, errcode)
+
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+ INTEGER(hid_t), INTENT(in) :: loc_id ! An array containing the sizes of the fields
+ CHARACTER(LEN=*), INTENT(in) :: table_name ! The name of the dataset to read
+ INTEGER(hsize_t), INTENT(in) :: nfields ! number of fields
+ INTEGER(size_t), INTENT(in) :: dst_size ! The size of the structure type
+ INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_offset ! An array containing the offsets of the fields
+ INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_sizes ! An array containing the sizes of the fields
+ TYPE(C_PTR), INTENT(OUT) :: dst_buf ! Buffer with data
+ INTEGER :: errcode ! error code
+
+ INTEGER(size_t) :: namelen ! name length
+ INTEGER(hsize_t) :: i ! general purpose integer
+
+ INTERFACE
+ INTEGER FUNCTION h5tbread_table_c(loc_id,&
+ table_name,&
+ namelen,&
+ nfields,&
+ dst_size,&
+ dst_offset, &
+ dst_sizes, &
+ dst_buf) &
+ BIND(C,NAME='h5tbread_table_c')
+ IMPORT :: C_PTR
+ IMPORT :: HID_T, SIZE_T, HSIZE_T
+ IMPLICIT NONE
+ INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier
+ CHARACTER(LEN=1), INTENT(in) :: table_name ! name of the dataset
+ INTEGER(hsize_t), INTENT(in) :: nfields
+ INTEGER(size_t), INTENT(in) :: dst_size ! type size
+ INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_offset ! An array containing the sizes of the fields
+ INTEGER(size_t), DIMENSION(1:nfields), INTENT(in) :: dst_sizes ! An array containing the sizes of the fields
+ INTEGER(size_t) :: namelen ! name length
+ TYPE(C_PTR), VALUE :: dst_buf
+
+ END FUNCTION h5tbread_table_c
+ END INTERFACE
+
+ namelen = LEN(table_name)
+
+ errcode = h5tbread_table_c(loc_id,&
+ table_name,&
+ namelen, &
+ nfields, &
+ dst_size,&
+ dst_offset, &
+ dst_sizes, &
+ dst_buf)
+
+
+ END SUBROUTINE h5tbread_table_f
!-------------------------------------------------------------------------
! Function: h5tbwrite_field_name_f_int
diff --git a/hl/fortran/src/hdf5_hl_fortrandll.def.in b/hl/fortran/src/hdf5_hl_fortrandll.def.in
index 9a1231a..b48cae3 100644
--- a/hl/fortran/src/hdf5_hl_fortrandll.def.in
+++ b/hl/fortran/src/hdf5_hl_fortrandll.def.in
@@ -72,7 +72,9 @@ H5LT_CONST_mp_H5LTGET_ATTRIBUTE_NDIMS_F
H5LT_CONST_mp_H5LTGET_ATTRIBUTE_INFO_F
H5LT_CONST_mp_H5LTPATH_VALID_F
; H5TB
-H5TB_CONST_mp_H5TBMAKE_TABLE_F
+H5TB_CONST_mp_H5TBREAD_TABLE_F
+H5TB_CONST_mp_H5TBMAKE_TABLE_F90
+H5TB_CONST_mp_H5TBMAKE_TABLE_PTR_F
H5TB_CONST_mp_H5TBWRITE_FIELD_NAME_F_INT
H5TB_CONST_mp_H5TBWRITE_FIELD_NAME_F_STRING
H5TB_CONST_mp_H5TBREAD_FIELD_NAME_F_INT
diff --git a/hl/fortran/test/Makefile.am b/hl/fortran/test/Makefile.am
index ca49817..32d367c 100644
--- a/hl/fortran/test/Makefile.am
+++ b/hl/fortran/test/Makefile.am
@@ -45,7 +45,7 @@ tstimage_SOURCES=tstimage.F90
tsttable_SOURCES=tsttable.F90
# Temporary files.
-CHECK_CLEANFILES+=dsetf[1-5].h5 f1img.h5 f1tab.h5 tstds.h5
+CHECK_CLEANFILES+=dsetf[1-5].h5 f1img.h5 f[1-2]tab.h5 tstds.h5
# Mark this directory as part of the Fortran API (this affects output
# from tests in conclude.am)
diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90
index 081e61e..3937c3c 100644
--- a/hl/fortran/test/tstlite.F90
+++ b/hl/fortran/test/tstlite.F90
@@ -1300,11 +1300,14 @@ SUBROUTINE test_datasets()
INTEGER(HID_T) :: file_id ! File identifier
INTEGER :: errcode ! Error flag
INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
+ INTEGER, PARAMETER :: LEN0 = 3
+ INTEGER, PARAMETER :: LEN1 = 12
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname5 = "dset5" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname6 = "dset6" ! Dataset name
INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions
INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! Dataset dimensions
INTEGER :: rank = 1 ! Dataset rank
@@ -1317,7 +1320,7 @@ SUBROUTINE test_datasets()
REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer
DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer
DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer
- INTEGER :: i, n ! general purpose integer
+ INTEGER :: i, j, n ! general purpose integer
INTEGER :: has ! general purpose integer
INTEGER :: type_class
INTEGER(SIZE_T) :: type_size
@@ -1326,6 +1329,17 @@ SUBROUTINE test_datasets()
CHARACTER(LEN=8) :: chr_lg
TYPE(C_PTR) :: f_ptr
+ ! vl data
+ TYPE vl
+ INTEGER, DIMENSION(:), POINTER :: DATA
+ END TYPE vl
+ TYPE(vl), DIMENSION(:), ALLOCATABLE, TARGET :: ptr
+ TYPE(hvl_t), DIMENSION(1:2), TARGET :: wdata ! Array of vlen structures
+ TYPE(hvl_t), DIMENSION(1:2), TARGET :: rdata ! Pointer to vlen structures
+ INTEGER(hsize_t), DIMENSION(1:1) :: dims_vl = (/2/)
+ INTEGER, DIMENSION(:), POINTER :: ptr_r
+ INTEGER(HID_T) :: type_id
+
!
! Initialize FORTRAN predefined datatypes.
!
@@ -1347,6 +1361,28 @@ SUBROUTINE test_datasets()
n = n + 1
END DO
+ !
+ ! Initialize variable-length data. wdata(1) is a countdown of
+ ! length LEN0, wdata(2) is a Fibonacci sequence of length LEN1.
+ !
+ wdata(1)%len = LEN0
+ wdata(2)%len = LEN1
+
+ ALLOCATE( ptr(1:2) )
+ ALLOCATE( ptr(1)%data(1:wdata(1)%len) )
+ ALLOCATE( ptr(2)%data(1:wdata(2)%len) )
+
+ DO i=1, wdata(1)%len
+ ptr(1)%data(i) = wdata(1)%len - i + 1 ! 3 2 1
+ ENDDO
+ wdata(1)%p = C_LOC(ptr(1)%data(1))
+
+ ptr(2)%data(1:2) = 1
+ DO i = 3, wdata(2)%len
+ ptr(2)%data(i) = ptr(2)%data(i-1) + ptr(2)%data(i-2) ! (1 1 2 3 5 8 etc.)
+ ENDDO
+ wdata(2)%p = C_LOC(ptr(2)%data(1))
+
!-------------------------------------------------------------------------
! int
!-------------------------------------------------------------------------
@@ -1430,7 +1466,6 @@ SUBROUTINE test_datasets()
!CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode)
CALL h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, errcode)
-
!
! compare read and write buffers.
!
@@ -1473,6 +1508,38 @@ SUBROUTINE test_datasets()
CALL passed()
+
+ !-------------------------------------------------------------------------
+ ! variable-length dataset
+ !-------------------------------------------------------------------------
+ CALL test_begin(' Make/Read datasets (vl) ')
+ !
+ ! Create variable-length datatype.
+ !
+ CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, type_id, errcode)
+
+ f_ptr = C_LOC(wdata(1))
+ CALL h5ltmake_dataset_f(file_id, dsetname6, 1, dims_vl, type_id, f_ptr, errcode)
+
+ ! Read the variable-length datatype
+ f_ptr = C_LOC(rdata(1))
+ CALL h5ltread_dataset_f(file_id, dsetname6, type_id, f_ptr, errcode)
+
+ DO i = 1, INT(dims_vl(1))
+ CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
+ DO j = 1, rdata(i)%len
+ IF(ptr_r(j).NE.ptr(i)%data(j))THEN
+ PRINT *, 'Writing/Reading variable-length dataset failed'
+ STOP
+ ENDIF
+ ENDDO
+ ENDDO
+
+ CALL H5Tclose_f(type_id, errcode)
+ DEALLOCATE(ptr)
+
+ CALL passed()
+
CALL test_begin(' Test h5ltpath_valid_f ')
!
! test function h5ltpath_valid_f
@@ -1528,7 +1595,6 @@ SUBROUTINE test_datasets()
CALL passed()
-
CALL test_begin(' Get dataset dimensions/info ')
!-------------------------------------------------------------------------
@@ -1573,6 +1639,8 @@ SUBROUTINE test_datasets()
STOP
ENDIF
+ CALL passed()
+
!
! Close the file.
!
@@ -1582,14 +1650,12 @@ SUBROUTINE test_datasets()
!
CALL h5close_f(errcode)
- CALL passed()
!
! end function.
!
END SUBROUTINE test_datasets
-
!-------------------------------------------------------------------------
! test_attributes
!-------------------------------------------------------------------------
diff --git a/hl/fortran/test/tsttable.F90 b/hl/fortran/test/tsttable.F90
index 74029a5..5c55a66 100644
--- a/hl/fortran/test/tsttable.F90
+++ b/hl/fortran/test/tsttable.F90
@@ -20,7 +20,24 @@
PROGRAM table_test
+ USE H5TB ! module of H5TB
+ USE HDF5 ! module of HDF5 library
+
+ IMPLICIT NONE
+ INTEGER :: errcode = 0
+
+ !
+ ! Initialize FORTRAN predefined datatypes.
+ !
+ CALL h5open_f(errcode)
+
CALL test_table1()
+ CALL test_table2()
+
+ !
+ ! Close FORTRAN predefined datatypes.
+ !
+ CALL h5close_f(errcode)
END PROGRAM table_test
@@ -35,13 +52,13 @@ SUBROUTINE test_table1()
USE HDF5 ! module of HDF5 library
IMPLICIT NONE
-
+
CHARACTER(len=8), PARAMETER :: filename = "f1tab.h5" ! File name
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HSIZE_T), PARAMETER :: nfields = 4 ! nfields
INTEGER(HSIZE_T), PARAMETER :: nrecords = 5 ! nrecords
- CHARACTER(LEN=10),DIMENSION(1:nfields) :: field_names ! field names
+ CHARACTER(LEN=9),DIMENSION(1:nfields) :: field_names ! field names
INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offset ! field offset
INTEGER(HID_T), DIMENSION(1:nfields) :: field_types ! field types
INTEGER(HSIZE_T), PARAMETER :: chunk_size = 5 ! chunk size
@@ -74,6 +91,7 @@ SUBROUTINE test_table1()
INTEGER :: Cs_sizeof_double = H5_SIZEOF_DOUBLE ! C's sizeof double
INTEGER :: SIZEOF_X
LOGICAL :: Exclude_double
+ CHARACTER(LEN=62) :: test_txt
! Find size of DOUBLE PRECISION
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
@@ -100,11 +118,6 @@ SUBROUTINE test_table1()
END DO
!
- ! Initialize FORTRAN predefined datatypes.
- !
- CALL h5open_f(errcode)
-
- !
! Create a new file using default properties.
!
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
@@ -164,7 +177,8 @@ SUBROUTINE test_table1()
! make table
!-------------------------------------------------------------------------
- CALL test_begin(' Make table ')
+ test_txt = " Make table"
+ CALL test_begin(test_txt)
CALL h5tbmake_table_f(dsetname1,&
file_id,&
@@ -186,7 +200,8 @@ SUBROUTINE test_table1()
! write field
!-------------------------------------------------------------------------
- CALL test_begin(' Read/Write field by name ')
+ test_txt = "Read/Write field by name"
+ CALL test_begin(test_txt)
CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,&
bufs,errcode)
@@ -309,7 +324,8 @@ SUBROUTINE test_table1()
! write field
!-------------------------------------------------------------------------
- CALL test_begin(' Read/Write field by index ')
+ test_txt = "Read/Write field by index"
+ CALL test_begin(test_txt)
CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,&
bufs,errcode)
@@ -413,8 +429,8 @@ SUBROUTINE test_table1()
! Insert field
! we insert a field callsed "field5" with the same type and buffer as field 4 (Real)
!-------------------------------------------------------------------------
-
- CALL test_begin(' Insert field ')
+ test_txt = "Insert field"
+ CALL test_begin(test_txt)
CALL h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode)
CALL h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,&
@@ -437,7 +453,8 @@ SUBROUTINE test_table1()
! Delete field
!-------------------------------------------------------------------------
- CALL test_begin(' Delete field ')
+ test_txt = "Delete field"
+ CALL test_begin(test_txt)
CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode)
@@ -448,7 +465,8 @@ SUBROUTINE test_table1()
! Gets the number of records and fields
!-------------------------------------------------------------------------
- CALL test_begin(' Get table info ')
+ test_txt = "Get table info"
+ CALL test_begin(test_txt)
CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode )
@@ -463,7 +481,8 @@ SUBROUTINE test_table1()
! Get information about fields
!-------------------------------------------------------------------------
- CALL test_begin(' Get fields info ')
+ test_txt = "Get fields info"
+ CALL test_begin(test_txt)
CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,&
field_offsetr, type_sizeout, errcode, maxlen )
@@ -502,16 +521,196 @@ SUBROUTINE test_table1()
!
CALL h5fclose_f(file_id, errcode)
- !
- ! Close FORTRAN predefined datatypes.
- !
- CALL h5close_f(errcode)
!
! end function.
!
END SUBROUTINE test_table1
+!-------------------------------------------------------------------------
+! test_table2
+! Tests F2003 versions of H5TBread_table_f and H5TBmake_table_f
+!-------------------------------------------------------------------------
+
+SUBROUTINE test_table2()
+
+ USE H5TB ! module of H5TB
+ USE HDF5 ! module of HDF5 library
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
+ INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(9) ! (18) !should map to INTEGER*8 on most modern processors
+ INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
+
+ TYPE particle_t
+ CHARACTER(LEN=11) :: name
+ INTEGER(KIND=int_kind_8) :: lati
+ INTEGER(KIND=int_kind_16) :: long
+ REAL(KIND=sp) :: pressure
+ REAL(KIND=dp) :: temperature
+ END TYPE particle_t
+
+ INTEGER(HSIZE_T), PARAMETER :: nfields = 5 ! nfields
+ INTEGER(HSIZE_T), PARAMETER :: nrecords = 8 ! nrecords
+
+ CHARACTER(len=8), PARAMETER :: filename = "f2tab.h5" ! File name
+ CHARACTER(LEN=5), PARAMETER :: table_name = "tabel" ! table name
+ CHARACTER(LEN=10), PARAMETER :: table_name_fill = "tabel_fill" ! table name
+
+ ! Define field information
+ CHARACTER(LEN=11), DIMENSION(1:NFIELDS), PARAMETER :: field_names = (/&
+ "Name ", &
+ "Latitude ", &
+ "Longitude ", &
+ "Pressure ", &
+ "Temperature" &
+ /)
+
+ INTEGER(hid_t), DIMENSION(1:nfields) :: field_type
+ INTEGER(hid_t) :: string_type
+ INTEGER(hid_t) :: file_id
+ INTEGER(hsize_t), PARAMETER :: chunk_size = 10
+ TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: fill_data
+ INTEGER :: compress
+ INTEGER :: status
+ INTEGER :: i
+ INTEGER(SIZE_T) :: dst_size
+ TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: dst_buf
+ INTEGER(SIZE_T), DIMENSION(1:nfields) :: dst_offset
+ INTEGER(SIZE_T), DIMENSION(1:nfields) :: dst_sizes
+ TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: p_data
+ TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: r_data
+
+ TYPE(C_PTR) :: f_ptr1, f_ptr2, f_ptr3
+
+ INTEGER :: errcode
+ CHARACTER(LEN=62) :: test_txt
+
+ test_txt = "Testing H5TBread_table_f and H5TBmake_table_f (F2003)"
+ CALL test_begin(test_txt)
+
+ ! Define an array of Particles
+ p_data(1:nrecords) = (/ &
+ particle_t("zero ",0_int_kind_8,0_int_kind_16,0.0_sp,0.0_dp), &
+ particle_t("one ",10_int_kind_8,10_int_kind_16,10.0_sp,10.0_dp), &
+ particle_t("two ",20_int_kind_8,20_int_kind_16,20.0_sp,20.0_dp), &
+ particle_t("three ",30_int_kind_8,30_int_kind_16,30.0_sp,30.0_dp),&
+ particle_t("four ",40_int_kind_8,40_int_kind_16,40.0_sp,40.0_dp), &
+ particle_t("five ",50_int_kind_8,50_int_kind_16,50.0_sp,50.0_dp), &
+ particle_t("six ",60_int_kind_8,60_int_kind_16,60.0_sp,60.0_dp), &
+ particle_t("seven ",70_int_kind_8,70_int_kind_16,70.0_sp,70.0_dp) &
+ /)
+
+ fill_data(1:nrecords) = particle_t("no data",-1_int_kind_8, -2_int_kind_16, -99.0_sp, -100.0_dp)
+
+ compress = 0
+
+ dst_size = H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(2)))
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ dst_sizes(1:nfields) = (/ &
+ storage_size(dst_buf(1)%name)/storage_size(c_char_'a'), &
+ storage_size(dst_buf(1)%lati)/storage_size(c_char_'a'), &
+ storage_size(dst_buf(1)%long)/storage_size(c_char_'a'), &
+ storage_size(dst_buf(1)%pressure)/storage_size(c_char_'a'), &
+ storage_size(dst_buf(1)%temperature)/storage_size(c_char_'a') &
+ /)
+#else
+ dst_sizes(1:nfields) = (/ &
+ sizeof(dst_buf(1)%name), &
+ sizeof(dst_buf(1)%lati), &
+ sizeof(dst_buf(1)%long), &
+ sizeof(dst_buf(1)%pressure), &
+ sizeof(dst_buf(1)%temperature) &
+ /)
+#endif
+
+ dst_offset(1:nfields) = (/ &
+ H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%name(1:1))), &
+ H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%lati)), &
+ H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%long)), &
+ H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%pressure)), &
+ H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%temperature)) &
+ /)
+
+ ! Initialize field_type
+ CALL H5Tcopy_f(H5T_FORTRAN_S1, string_type, errcode)
+ CALL H5Tset_size_f(string_type, INT(11,size_t), errcode)
+
+ field_type(1:5) = (/ &
+ string_type,&
+ h5kind_to_type(KIND(dst_buf(1)%lati), H5_INTEGER_KIND),&
+ h5kind_to_type(KIND(dst_buf(1)%long), H5_INTEGER_KIND),&
+ h5kind_to_type(KIND(dst_buf(1)%pressure), H5_REAL_KIND),&
+ h5kind_to_type(KIND(dst_buf(1)%temperature), H5_REAL_KIND) &
+ /)
+
+ !
+ ! Create a new file using default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
+
+ ! Check setting the fill values
+
+ f_ptr1 = C_NULL_PTR
+ f_ptr2 = C_LOC(fill_data(1)%name(1:1))
+
+ CALL h5tbmake_table_f("Table Title Fill", file_id, table_name_fill, nfields, nrecords, &
+ dst_size, field_names, dst_offset, field_type, &
+ chunk_size, f_ptr2, compress, f_ptr1, errcode )
+
+ f_ptr3 = C_LOC(r_data(1)%name(1:1))
+ CALL h5tbread_table_f(file_id, table_name_fill, nfields, dst_size, dst_offset, dst_sizes, f_ptr3, errcode)
+
+ DO i = 1, nfields
+ IF(r_data(i)%name.NE.fill_data(i)%name.OR. &
+ r_data(i)%lati.NE.fill_data(i)%lati.OR. &
+ r_data(i)%long.NE.fill_data(i)%long.OR. &
+ r_data(i)%pressure.NE.fill_data(i)%pressure.OR. &
+ r_data(i)%temperature.NE.fill_data(i)%temperature)THEN
+ PRINT*,'H5TBmake/read_table_f --filled-- FAILED'
+ STOP
+ ENDIF
+ ENDDO
+
+ ! Check setting the table values
+
+ f_ptr1 = C_LOC(p_data(1)%name(1:1))
+ f_ptr2 = C_NULL_PTR
+
+ CALL h5tbmake_table_f("Table Title",file_id, table_name, nfields, nrecords, &
+ dst_size, field_names, dst_offset, field_type, &
+ chunk_size, f_ptr2, compress, f_ptr1, errcode )
+
+ f_ptr3 = C_LOC(r_data(1)%name(1:1))
+ CALL h5tbread_table_f(file_id, table_name, nfields, dst_size, dst_offset, dst_sizes, f_ptr3, errcode)
+
+ DO i = 1, nfields
+ IF(r_data(i)%name.NE.p_data(i)%name.OR. &
+ r_data(i)%lati.NE.p_data(i)%lati.OR. &
+ r_data(i)%long.NE.p_data(i)%long.OR. &
+ r_data(i)%pressure.NE.p_data(i)%pressure.OR. &
+ r_data(i)%temperature.NE.p_data(i)%temperature)THEN
+ PRINT*,'H5TBmake/read_table_f FAILED'
+ STOP
+ ENDIF
+ ENDDO
+
+ CALL passed()
+
+ !-------------------------------------------------------------------------
+ ! end
+ !-------------------------------------------------------------------------
+
+ !
+ ! Close the file.
+ !
+ CALL h5fclose_f(file_id, errcode)
+
+END SUBROUTINE test_table2
+
!-------------------------------------------------------------------------
! test_begin
@@ -519,8 +718,7 @@ END SUBROUTINE test_table1
SUBROUTINE test_begin(string)
CHARACTER(LEN=*), INTENT(IN) :: string
- WRITE(*, fmt = '(14a)', advance = 'no') string
- WRITE(*, fmt = '(40x,a)', advance = 'no') ' '
+ WRITE(*, fmt = '(A)', ADVANCE = 'no') string
END SUBROUTINE test_begin
!-------------------------------------------------------------------------
@@ -528,7 +726,7 @@ END SUBROUTINE test_begin
!-------------------------------------------------------------------------
SUBROUTINE passed()
- WRITE(*, fmt = '(6a)') 'PASSED'
+ WRITE(*, fmt = '(T12,A6)') 'PASSED'
END SUBROUTINE passed
diff --git a/hl/test/test_lite.c b/hl/test/test_lite.c
index f3258d6..6cadd95 100644
--- a/hl/test/test_lite.c
+++ b/hl/test/test_lite.c
@@ -2066,6 +2066,15 @@ static int test_valid_path(void)
/**************************************
* CHECK ABSOLUTE PATHS
**************************************/
+
+ if( (path_valid = H5LTpath_valid(file_id, "/", TRUE)) != TRUE) {
+ goto out;
+ }
+
+ if( (path_valid = H5LTpath_valid(file_id, "/", FALSE)) != TRUE) {
+ goto out;
+ }
+
if( (path_valid = H5LTpath_valid(file_id, "/G1", TRUE)) != TRUE) {
goto out;
}
@@ -2112,6 +2121,20 @@ static int test_valid_path(void)
* CHECK RELATIVE PATHS
***************************************/
+ if( (group = H5Gopen2(file_id, "/", H5P_DEFAULT)) < 0)
+ goto out;
+
+ if( (path_valid = H5LTpath_valid(group, "/", TRUE)) != TRUE) {
+ goto out;
+ }
+
+ if( (path_valid = H5LTpath_valid(group, "/", FALSE)) != TRUE) {
+ goto out;
+ }
+
+ if(H5Gclose(group)<0)
+ goto out;
+
if( (group = H5Gopen2(file_id, "/G1", H5P_DEFAULT)) < 0)
goto out;