diff options
| -rw-r--r-- | hl/fortran/src/H5LTf90proto.h | 32 | ||||
| -rw-r--r-- | hl/fortran/src/H5TBfc.c | 276 | ||||
| -rw-r--r-- | hl/fortran/src/H5TBff.F90 | 187 | ||||
| -rw-r--r-- | hl/fortran/src/hdf5_hl_fortrandll.def.in | 4 | ||||
| -rw-r--r-- | hl/fortran/test/Makefile.am | 2 | ||||
| -rw-r--r-- | hl/fortran/test/tsttable.F90 | 242 |
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 |