summaryrefslogtreecommitdiffstats
path: root/hl
diff options
context:
space:
mode:
Diffstat (limited to 'hl')
-rw-r--r--hl/fortran/src/H5LTf90proto.h32
-rw-r--r--hl/fortran/src/H5TBfc.c276
-rw-r--r--hl/fortran/src/H5TBff.F90187
-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/tsttable.F90242
6 files changed, 621 insertions, 122 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/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..0e2c3dd 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,167 @@ 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 ! file or group identifier
+ CHARACTER(LEN=*), INTENT(in) :: table_name ! name of the dataset
+ INTEGER(hsize_t), INTENT(in) :: nfields ! fields
+ 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
+ TYPE(C_PTR), INTENT(OUT) :: dst_buf
+ 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/tsttable.F90 b/hl/fortran/test/tsttable.F90
index 74029a5..a87f783 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)), &
+ 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