diff options
| author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2011-03-06 22:20:56 (GMT) |
|---|---|---|
| committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2011-03-06 22:20:56 (GMT) |
| commit | 86f15d4a3326979f8a0b3898a0b7eccc453a6d38 (patch) | |
| tree | 871143b399ffd612e6dc96fe56644e87d4b22481 /hl | |
| parent | 0619b155aaaa2ca002bcbadba081c137d9554d24 (diff) | |
| download | hdf5-86f15d4a3326979f8a0b3898a0b7eccc453a6d38.zip hdf5-86f15d4a3326979f8a0b3898a0b7eccc453a6d38.tar.gz hdf5-86f15d4a3326979f8a0b3898a0b7eccc453a6d38.tar.bz2 | |
[svn-r20192] Description: Bug 1939: h5tbget_field_info_f
* Fixed error in passing an array of characters with different length
field names for h5tbmake_table.
* Fixed error in h5tget_field_info_f with packing the C strings
into a fortran array of strings.
* Added optional arguement to h5tbget_field_info_f called maxlen
which returns the maximum string character length in a field name
element.
* Uncommented out test for h5tbget_field_info_f in the test program
and added additional checks for the output.
Tested: jam (intel and gnu compilers)
Diffstat (limited to 'hl')
| -rwxr-xr-x | hl/fortran/src/H5LTf90proto.h | 11 | ||||
| -rwxr-xr-x | hl/fortran/src/H5TBfc.c | 65 | ||||
| -rwxr-xr-x | hl/fortran/src/H5TBff.f90 | 1578 | ||||
| -rwxr-xr-x | hl/fortran/test/tsttable.f90 | 722 |
4 files changed, 1203 insertions, 1173 deletions
diff --git a/hl/fortran/src/H5LTf90proto.h b/hl/fortran/src/H5LTf90proto.h index c0de5ea..75a6fcc 100755 --- a/hl/fortran/src/H5LTf90proto.h +++ b/hl/fortran/src/H5LTf90proto.h @@ -759,7 +759,8 @@ nh5tbmake_table_c(int_f *namelen1, hid_t_f *field_types, hsize_t_f *chunk_size, int_f *compress, - int_f *len, /* field_names lenghts */ + int_f *char_len_field_names, /* field_names lenghts */ + int_f *max_char_size_field_names, /* char len of fields */ _fcd buf); /* field_names */ HDF5_HL_F90CSTUBDLL @@ -1069,10 +1070,10 @@ nh5tbget_field_info_c(hid_t_f *loc_id, size_t_f *field_sizes, size_t_f *field_offsets, size_t_f *type_size, - int_f *namelen2, /* field_names lenghts */ - _fcd field_names) ; /* field_names */ - - + int_f *namelen2, + int_f *lenmax, + _fcd field_names, + int_f *maxlen_out); #endif /* _H5LTf90proto_H */ diff --git a/hl/fortran/src/H5TBfc.c b/hl/fortran/src/H5TBfc.c index 76a3f1c..891f387 100755 --- a/hl/fortran/src/H5TBfc.c +++ b/hl/fortran/src/H5TBfc.c @@ -13,6 +13,8 @@ * access to either file, you may request a copy from help@hdfgroup.org. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ +#include <math.h> + /* This files contains C stubs for H5D Fortran APIs */ #include "H5TBprivate.h" @@ -47,25 +49,22 @@ nh5tbmake_table_c(int_f *namelen1, hid_t_f *field_types, hsize_t_f *chunk_size, int_f *compress, - int_f *namelen2, /* field_names lenghts */ - _fcd field_names) /* field_names */ + int_f *char_len_field_names, /* field_names lenghts */ + int_f *max_char_size_field_names, /* char len of fields */ + char *field_names) /* field_names */ { char *c_name = NULL; char *c_name1 = NULL; hsize_t num_elem; hsize_t i; - int max_len = 1; 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; + char *tmp = NULL; int_f ret_value = 0; num_elem = *nfields; - for(i = 0; i < num_elem; i++) - if(namelen2[i] > max_len) - max_len = namelen2[i]; /* * convert FORTRAN name to C name @@ -91,20 +90,18 @@ nh5tbmake_table_c(int_f *namelen1, HGOTO_DONE(FAIL) /* copy data to long C string */ - if(NULL == (tmp = (char *)HD5f2cstring(field_names, (size_t)(max_len * num_elem)))) + 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)namelen2[i] + 1))) + 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, (size_t)char_len_field_names[i]); + c_field_names[i][char_len_field_names[i]] = '\0'; - HDmemcpy(c_field_names[i], tmp_p, (size_t)namelen2[i]); - c_field_names[i][namelen2[i]] = '\0'; - tmp_p = tmp_p + max_len; + tmp = tmp + *max_char_size_field_names; } /* end for */ /* @@ -125,10 +122,7 @@ done: 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) @@ -616,10 +610,10 @@ nh5tbinsert_field_c(hid_t_f *loc_id, HGOTO_DONE(FAIL) if(NULL == (c_name1 = (char *)HD5f2cstring(field_name, (size_t)*namelen1))) HGOTO_DONE(FAIL) - /* * call H5TBinsert_field function. */ + if(H5TBinsert_field((hid_t)*loc_id, c_name, c_name1, (hid_t)*field_type, (hsize_t)*position, NULL, buf) < 0) HGOTO_DONE(FAIL) @@ -771,13 +765,14 @@ nh5tbget_table_info_c(hid_t_f *loc_id, if(NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) HGOTO_DONE(FAIL) + /* * call H5TBread_fields_index function. */ + if(H5TBget_table_info((hid_t)*loc_id, c_name, &c_nfields, &c_nrecords) < 0) HGOTO_DONE(FAIL) - - *nfields = (hsize_t_f) c_nfields;; + *nfields = (hsize_t_f) c_nfields; *nrecords = (hsize_t_f) c_nrecords; done: @@ -811,26 +806,27 @@ nh5tbget_field_info_c(hid_t_f *loc_id, size_t_f *field_offsets, size_t_f *type_size, int_f *namelen2, /* field_names lenghts */ - _fcd field_names) /* field_names */ + int_f *lenmax, /* character len max */ + _fcd field_names, /* field_names */ + int_f *maxlen_out) { char *c_name = NULL; hsize_t num_elem; - int max_len = 1; hsize_t c_nfields = *nfields; size_t *c_field_sizes = NULL; size_t *c_field_offsets = NULL; size_t c_type_size; char **c_field_names = NULL; char *tmp = NULL, *tmp_p; - int c_lenmax = HLTB_MAX_FIELD_LEN; hsize_t i; int_f ret_value = 0; + size_t c_lenmax; + size_t length = 0; + + c_lenmax = (size_t)*lenmax; num_elem = c_nfields; - for(i = 0; i < num_elem; i++) - if(namelen2[i] > max_len) - max_len = namelen2[i]; /* * convert FORTRAN name to C name @@ -854,24 +850,25 @@ nh5tbget_field_info_c(hid_t_f *loc_id, if(H5TBget_field_info((hid_t)*loc_id, c_name, c_field_names, c_field_sizes, c_field_offsets, &c_type_size) < 0) HGOTO_DONE(FAIL) - + /* return values */ /* names array */ if(NULL == (tmp = (char *)HDmalloc((c_lenmax * (size_t)c_nfields) + 1))) HGOTO_DONE(FAIL) - tmp_p = tmp; HDmemset(tmp, ' ', c_lenmax * (size_t)c_nfields); tmp[c_lenmax * c_nfields] = '\0'; for(i = 0; i < c_nfields; i++) { - size_t field_name_len = HDstrlen(c_field_names[i]); + size_t field_name_len = HDstrlen(c_field_names[i]); - HDmemcpy(tmp_p, c_field_names[i], field_name_len); - namelen2[i] = (int_f)field_name_len; - tmp_p += c_lenmax; + HDmemcpy(tmp_p, c_field_names[i], field_name_len); + namelen2[i] = (int_f)field_name_len; + length = MAX(length, strlen((c_field_names[i]))); + tmp_p = tmp_p + c_lenmax; } /* end for */ - HD5packFstring(tmp, _fcdtocp(field_names), (int)(c_lenmax * c_nfields)); + + HD5packFstring(tmp, _fcdtocp(field_names), (size_t)( c_lenmax* c_nfields)); *type_size = (size_t_f)c_type_size; for(i = 0; i < num_elem; i++) { @@ -879,6 +876,8 @@ nh5tbget_field_info_c(hid_t_f *loc_id, field_offsets[i] = (size_t_f)c_field_offsets[i]; } /* end for */ + *maxlen_out = (int_f)length; + done: if(c_name) HDfree(c_name); diff --git a/hl/fortran/src/H5TBff.f90 b/hl/fortran/src/H5TBff.f90 index 9acdcee..202c197 100755 --- a/hl/fortran/src/H5TBff.f90 +++ b/hl/fortran/src/H5TBff.f90 @@ -17,49 +17,49 @@ ! This file contains FORTRAN90 interfaces for H5TB functions ! -module h5tb -use h5fortran_types -use hdf5 +MODULE h5tb +USE h5fortran_types +USE hdf5 -interface h5tbwrite_field_name_f - module procedure h5tbwrite_field_name_f_int - module procedure h5tbwrite_field_name_f_float - module procedure h5tbwrite_field_name_f_double - module procedure h5tbwrite_field_name_f_string -end interface +INTERFACE h5tbwrite_field_name_f + MODULE PROCEDURE h5tbwrite_field_name_f_int + MODULE PROCEDURE h5tbwrite_field_name_f_float + MODULE PROCEDURE h5tbwrite_field_name_f_double + MODULE PROCEDURE h5tbwrite_field_name_f_string +END INTERFACE -interface h5tbread_field_name_f - module procedure h5tbread_field_name_f_int - module procedure h5tbread_field_name_f_float - module procedure h5tbread_field_name_f_double - module procedure h5tbread_field_name_f_string -end interface +INTERFACE h5tbread_field_name_f + MODULE PROCEDURE h5tbread_field_name_f_int + MODULE PROCEDURE h5tbread_field_name_f_float + MODULE PROCEDURE h5tbread_field_name_f_double + MODULE PROCEDURE h5tbread_field_name_f_string +END INTERFACE -interface h5tbwrite_field_index_f - module procedure h5tbwrite_field_index_f_int - module procedure h5tbwrite_field_index_f_float - module procedure h5tbwrite_field_index_f_double - module procedure h5tbwrite_field_index_f_string -end interface +INTERFACE h5tbwrite_field_index_f + MODULE PROCEDURE h5tbwrite_field_index_f_int + MODULE PROCEDURE h5tbwrite_field_index_f_float + MODULE PROCEDURE h5tbwrite_field_index_f_double + MODULE PROCEDURE h5tbwrite_field_index_f_string +END INTERFACE -interface h5tbread_field_index_f - module procedure h5tbread_field_index_f_int - module procedure h5tbread_field_index_f_float - module procedure h5tbread_field_index_f_double - module procedure h5tbread_field_index_f_string -end interface +INTERFACE h5tbread_field_index_f + MODULE PROCEDURE h5tbread_field_index_f_int + MODULE PROCEDURE h5tbread_field_index_f_float + MODULE PROCEDURE h5tbread_field_index_f_double + MODULE PROCEDURE h5tbread_field_index_f_string +END INTERFACE -interface h5tbinsert_field_f - module procedure h5tbinsert_field_f_int - module procedure h5tbinsert_field_f_float - module procedure h5tbinsert_field_f_double - module procedure h5tbinsert_field_f_string -end interface +INTERFACE h5tbinsert_field_f + MODULE PROCEDURE h5tbinsert_field_f_int + MODULE PROCEDURE h5tbinsert_field_f_float + MODULE PROCEDURE h5tbinsert_field_f_double + MODULE PROCEDURE h5tbinsert_field_f_string +END INTERFACE -contains +CONTAINS !------------------------------------------------------------------------- @@ -79,7 +79,7 @@ contains ! !------------------------------------------------------------------------- -subroutine h5tbmake_table_f(table_title,& +SUBROUTINE h5tbmake_table_f(table_title,& loc_id,& dset_name,& nfields,& @@ -92,7 +92,7 @@ subroutine h5tbmake_table_f(table_title,& compress,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -101,68 +101,75 @@ subroutine h5tbmake_table_f(table_title,& !DEC$endif ! - 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(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 - integer, intent(in) :: compress ! compress - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code - integer, dimension(nfields) :: namelen2 ! name lengths - integer :: i ! general purpose integer - - - interface - integer function h5tbmake_table_c(namelen1,& - table_title,& - loc_id,& - namelen,& - dset_name,& - nfields,& - nrecords,& - type_size,& - field_offset,& - field_types,& - chunk_size,& - compress,& - namelen2,& - field_names) - - use h5global - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBMAKE_TABLE_C'::h5tbmake_table_c - !DEC$ENDIF - !DEC$ATTRIBUTES reference :: dset_name - !DEC$ATTRIBUTES reference :: table_title - 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(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 - integer, intent(in) :: compress ! compress - integer :: namelen ! name length - integer :: namelen1 ! name length - integer, dimension(nfields) :: namelen2 ! name lengths - end function h5tbmake_table_c - end interface - - namelen = len(dset_name) - namelen1 = len(table_title) - do i = 1, nfields - namelen2(i) = len(field_names(i)); - end do + 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 + INTEGER, INTENT(in) :: compress ! compress + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code + INTEGER, DIMENSION(1:nfields) :: char_len_field_names ! field name lengths + INTEGER :: max_char_size_field_names ! character len of field names + INTEGER :: i ! general purpose integer + + + INTERFACE + INTEGER FUNCTION 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) + + USE h5global + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBMAKE_TABLE_C'::h5tbmake_table_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: dset_name + !DEC$ATTRIBUTES reference :: table_title + 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(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 + INTEGER, INTENT(in) :: compress ! compress + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER, DIMENSION(nfields) :: char_len_field_names ! field name's lengths + INTEGER :: max_char_size ! character len of field names + END FUNCTION h5tbmake_table_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_c(namelen1,& table_title,& @@ -176,10 +183,11 @@ subroutine h5tbmake_table_f(table_title,& field_types,& chunk_size,& compress,& - namelen2,& + char_len_field_names, & + max_char_size_field_names, & field_names) -end subroutine h5tbmake_table_f +END SUBROUTINE h5tbmake_table_f !------------------------------------------------------------------------- @@ -197,7 +205,7 @@ end subroutine h5tbmake_table_f ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_name_f_int(loc_id,& +SUBROUTINE h5tbwrite_field_name_f_int(loc_id,& dset_name,& field_name,& start,& @@ -206,7 +214,7 @@ subroutine h5tbwrite_field_name_f_int(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -215,47 +223,47 @@ subroutine h5tbwrite_field_name_f_int(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbwrite_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_NAME_INT_C'::h5tbwrite_field_name_int_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbwrite_field_name_int_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbwrite_field_name_int_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbwrite_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_name_f_int +END SUBROUTINE h5tbwrite_field_name_f_int !------------------------------------------------------------------------- ! Function: h5tbwrite_field_name_f_float @@ -272,7 +280,7 @@ end subroutine h5tbwrite_field_name_f_int ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_name_f_float(loc_id,& +SUBROUTINE h5tbwrite_field_name_f_float(loc_id,& dset_name,& field_name,& start,& @@ -281,7 +289,7 @@ subroutine h5tbwrite_field_name_f_float(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -290,47 +298,47 @@ subroutine h5tbwrite_field_name_f_float(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbwrite_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_NAME_FL_C'::h5tbwrite_field_name_fl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbwrite_field_name_fl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbwrite_field_name_fl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbwrite_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_name_f_float +END SUBROUTINE h5tbwrite_field_name_f_float @@ -349,7 +357,7 @@ end subroutine h5tbwrite_field_name_f_float ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_name_f_double(loc_id,& +SUBROUTINE h5tbwrite_field_name_f_double(loc_id,& dset_name,& field_name,& start,& @@ -358,7 +366,7 @@ subroutine h5tbwrite_field_name_f_double(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -367,47 +375,47 @@ subroutine h5tbwrite_field_name_f_double(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbwrite_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_NAME_DL_C'::h5tbwrite_field_name_dl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbwrite_field_name_dl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbwrite_field_name_dl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbwrite_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_name_f_double +END SUBROUTINE h5tbwrite_field_name_f_double !------------------------------------------------------------------------- ! Function: h5tbwrite_field_name_f_string @@ -424,7 +432,7 @@ end subroutine h5tbwrite_field_name_f_double ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_name_f_string(loc_id,& +SUBROUTINE h5tbwrite_field_name_f_string(loc_id,& dset_name,& field_name,& start,& @@ -433,7 +441,7 @@ subroutine h5tbwrite_field_name_f_string(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -442,47 +450,47 @@ subroutine h5tbwrite_field_name_f_string(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbwrite_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_NAME_ST_C'::h5tbwrite_field_name_st_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbwrite_field_name_st_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbwrite_field_name_st_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbwrite_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_name_f_string +END SUBROUTINE h5tbwrite_field_name_f_string !------------------------------------------------------------------------- @@ -500,7 +508,7 @@ end subroutine h5tbwrite_field_name_f_string ! !------------------------------------------------------------------------- -subroutine h5tbread_field_name_f_int(loc_id,& +SUBROUTINE h5tbread_field_name_f_int(loc_id,& dset_name,& field_name,& start,& @@ -509,7 +517,7 @@ subroutine h5tbread_field_name_f_int(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -518,47 +526,47 @@ subroutine h5tbread_field_name_f_int(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbread_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbread_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_NAME_INT_C'::h5tbread_field_name_int_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbread_field_name_int_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbread_field_name_int_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbread_field_name_int_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_name_f_int +END SUBROUTINE h5tbread_field_name_f_int !------------------------------------------------------------------------- ! Function: h5tbread_field_name_f_float @@ -575,7 +583,7 @@ end subroutine h5tbread_field_name_f_int ! !------------------------------------------------------------------------- -subroutine h5tbread_field_name_f_float(loc_id,& +SUBROUTINE h5tbread_field_name_f_float(loc_id,& dset_name,& field_name,& start,& @@ -584,7 +592,7 @@ subroutine h5tbread_field_name_f_float(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -593,47 +601,47 @@ subroutine h5tbread_field_name_f_float(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbread_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbread_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_NAME_FL_C'::h5tbread_field_name_fl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbread_field_name_fl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbread_field_name_fl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbread_field_name_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_name_f_float +END SUBROUTINE h5tbread_field_name_f_float !------------------------------------------------------------------------- ! Function: h5tbread_field_name_f_double @@ -650,7 +658,7 @@ end subroutine h5tbread_field_name_f_float ! !------------------------------------------------------------------------- -subroutine h5tbread_field_name_f_double(loc_id,& +SUBROUTINE h5tbread_field_name_f_double(loc_id,& dset_name,& field_name,& start,& @@ -659,7 +667,7 @@ subroutine h5tbread_field_name_f_double(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -668,47 +676,47 @@ subroutine h5tbread_field_name_f_double(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbread_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbread_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_NAME_DL_C'::h5tbread_field_name_dl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbread_field_name_dl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbread_field_name_dl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbread_field_name_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_name_f_double +END SUBROUTINE h5tbread_field_name_f_double !------------------------------------------------------------------------- ! Function: h5tbread_field_name_f_string @@ -725,7 +733,7 @@ end subroutine h5tbread_field_name_f_double ! !------------------------------------------------------------------------- -subroutine h5tbread_field_name_f_string(loc_id,& +SUBROUTINE h5tbread_field_name_f_string(loc_id,& dset_name,& field_name,& start,& @@ -734,7 +742,7 @@ subroutine h5tbread_field_name_f_string(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -743,47 +751,47 @@ subroutine h5tbread_field_name_f_string(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length - interface - integer function h5tbread_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbread_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_NAME_ST_C'::h5tbread_field_name_st_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - integer :: namelen1 ! name length - end function h5tbread_field_name_st_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + END FUNCTION h5tbread_field_name_st_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbread_field_name_st_c(loc_id,namelen,dset_name,namelen1,field_name,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_name_f_string +END SUBROUTINE h5tbread_field_name_f_string !------------------------------------------------------------------------- @@ -801,7 +809,7 @@ end subroutine h5tbread_field_name_f_string ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_index_f_int(loc_id,& +SUBROUTINE h5tbwrite_field_index_f_int(loc_id,& dset_name,& field_index,& start,& @@ -810,7 +818,7 @@ subroutine h5tbwrite_field_index_f_int(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -819,43 +827,43 @@ subroutine h5tbwrite_field_index_f_int(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbwrite_field_index_int_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_index_int_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_INDEX_INT_C'::h5tbwrite_field_index_int_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbwrite_field_index_int_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbwrite_field_index_int_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbwrite_field_index_int_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_index_f_int +END SUBROUTINE h5tbwrite_field_index_f_int !------------------------------------------------------------------------- ! Function: h5tbwrite_field_index_f_float @@ -872,7 +880,7 @@ end subroutine h5tbwrite_field_index_f_int ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_index_f_float(loc_id,& +SUBROUTINE h5tbwrite_field_index_f_float(loc_id,& dset_name,& field_index,& start,& @@ -881,7 +889,7 @@ subroutine h5tbwrite_field_index_f_float(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -890,43 +898,43 @@ subroutine h5tbwrite_field_index_f_float(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbwrite_field_index_fl_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_index_fl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_INDEX_FL_C'::h5tbwrite_field_index_fl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbwrite_field_index_fl_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbwrite_field_index_fl_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbwrite_field_index_fl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_index_f_float +END SUBROUTINE h5tbwrite_field_index_f_float @@ -945,7 +953,7 @@ end subroutine h5tbwrite_field_index_f_float ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_index_f_double(loc_id,& +SUBROUTINE h5tbwrite_field_index_f_double(loc_id,& dset_name,& field_index,& start,& @@ -954,7 +962,7 @@ subroutine h5tbwrite_field_index_f_double(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -963,43 +971,43 @@ subroutine h5tbwrite_field_index_f_double(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbwrite_field_index_dl_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_index_dl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_INDEX_DL_C'::h5tbwrite_field_index_dl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbwrite_field_index_dl_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbwrite_field_index_dl_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbwrite_field_index_dl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_index_f_double +END SUBROUTINE h5tbwrite_field_index_f_double !------------------------------------------------------------------------- ! Function: h5tbwrite_field_index_f_string @@ -1016,7 +1024,7 @@ end subroutine h5tbwrite_field_index_f_double ! !------------------------------------------------------------------------- -subroutine h5tbwrite_field_index_f_string(loc_id,& +SUBROUTINE h5tbwrite_field_index_f_string(loc_id,& dset_name,& field_index,& start,& @@ -1025,7 +1033,7 @@ subroutine h5tbwrite_field_index_f_string(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1034,43 +1042,43 @@ subroutine h5tbwrite_field_index_f_string(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbwrite_field_index_st_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbwrite_field_index_st_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBWRITE_FIELD_INDEX_ST_C'::h5tbwrite_field_index_st_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbwrite_field_index_st_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbwrite_field_index_st_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbwrite_field_index_st_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbwrite_field_index_f_string +END SUBROUTINE h5tbwrite_field_index_f_string !------------------------------------------------------------------------- @@ -1088,7 +1096,7 @@ end subroutine h5tbwrite_field_index_f_string ! !------------------------------------------------------------------------- -subroutine h5tbread_field_index_f_int(loc_id,& +SUBROUTINE h5tbread_field_index_f_int(loc_id,& dset_name,& field_index,& start,& @@ -1097,7 +1105,7 @@ subroutine h5tbread_field_index_f_int(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1106,43 +1114,43 @@ subroutine h5tbread_field_index_f_int(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbread_field_index_int_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbread_field_index_int_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_INDEX_INT_C'::h5tbread_field_index_int_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbread_field_index_int_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbread_field_index_int_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbread_field_index_int_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_index_f_int +END SUBROUTINE h5tbread_field_index_f_int !------------------------------------------------------------------------- ! Function: h5tbread_field_index_f_float @@ -1159,7 +1167,7 @@ end subroutine h5tbread_field_index_f_int ! !------------------------------------------------------------------------- -subroutine h5tbread_field_index_f_float(loc_id,& +SUBROUTINE h5tbread_field_index_f_float(loc_id,& dset_name,& field_index,& start,& @@ -1168,7 +1176,7 @@ subroutine h5tbread_field_index_f_float(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1177,43 +1185,43 @@ subroutine h5tbread_field_index_f_float(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbread_field_index_fl_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbread_field_index_fl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_INDEX_FL_C'::h5tbread_field_index_fl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - real, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbread_field_index_fl_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbread_field_index_fl_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbread_field_index_fl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_index_f_float +END SUBROUTINE h5tbread_field_index_f_float !------------------------------------------------------------------------- ! Function: h5tbread_field_index_f_double @@ -1230,7 +1238,7 @@ end subroutine h5tbread_field_index_f_float ! !------------------------------------------------------------------------- -subroutine h5tbread_field_index_f_double(loc_id,& +SUBROUTINE h5tbread_field_index_f_double(loc_id,& dset_name,& field_index,& start,& @@ -1239,7 +1247,7 @@ subroutine h5tbread_field_index_f_double(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1248,43 +1256,43 @@ subroutine h5tbread_field_index_f_double(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbread_field_index_dl_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbread_field_index_dl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_INDEX_DL_C'::h5tbread_field_index_dl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbread_field_index_dl_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbread_field_index_dl_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbread_field_index_dl_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_index_f_double +END SUBROUTINE h5tbread_field_index_f_double !------------------------------------------------------------------------- ! Function: h5tbread_field_index_f_string @@ -1301,7 +1309,7 @@ end subroutine h5tbread_field_index_f_double ! !------------------------------------------------------------------------- -subroutine h5tbread_field_index_f_string(loc_id,& +SUBROUTINE h5tbread_field_index_f_string(loc_id,& dset_name,& field_index,& start,& @@ -1310,7 +1318,7 @@ subroutine h5tbread_field_index_f_string(loc_id,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1319,43 +1327,43 @@ subroutine h5tbread_field_index_f_string(loc_id,& !DEC$endif ! - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbread_field_index_st_c(loc_id,namelen,dset_name,field_index,& + INTERFACE + INTEGER FUNCTION h5tbread_field_index_st_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBREAD_FIELD_INDEX_ST_C'::h5tbread_field_index_st_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - integer(hid_t), intent(in) :: loc_id ! file or group identifier - character(len=*), intent(in) :: dset_name ! name of the dataset - integer, intent(in) :: field_index ! index - integer(hsize_t), intent(in) :: start ! start record - integer(hsize_t), intent(in) :: nrecords ! records - integer(size_t), intent(in) :: type_size ! type size - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: errcode ! error code - integer :: namelen ! name length - end function h5tbread_field_index_st_c - end interface - - namelen = len(dset_name) + INTEGER(hid_t), INTENT(in) :: loc_id ! file or group identifier + CHARACTER(LEN=*), INTENT(in) :: dset_name ! name of the dataset + INTEGER, INTENT(in) :: field_index ! index + INTEGER(hsize_t), INTENT(in) :: start ! start record + INTEGER(hsize_t), INTENT(in) :: nrecords ! records + INTEGER(size_t), INTENT(in) :: type_size ! type size + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length + END FUNCTION h5tbread_field_index_st_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbread_field_index_st_c(loc_id,namelen,dset_name,field_index,& start,nrecords,type_size,buf) -end subroutine h5tbread_field_index_f_string +END SUBROUTINE h5tbread_field_index_f_string !------------------------------------------------------------------------- @@ -1373,14 +1381,14 @@ end subroutine h5tbread_field_index_f_string ! !------------------------------------------------------------------------- -subroutine h5tbinsert_field_f_int(loc_id,& +SUBROUTINE h5tbinsert_field_f_int(loc_id,& dset_name,& field_name,& field_type,& field_index,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1389,45 +1397,45 @@ subroutine h5tbinsert_field_f_int(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code - interface - integer function h5tbinsert_field_int_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbinsert_field_int_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBINSERT_FIELD_INT_C'::h5tbinsert_field_int_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - integer, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length length - end function h5tbinsert_field_int_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + INTEGER, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length length + END FUNCTION h5tbinsert_field_int_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbinsert_field_int_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) -end subroutine h5tbinsert_field_f_int +END SUBROUTINE h5tbinsert_field_f_int @@ -1446,14 +1454,14 @@ end subroutine h5tbinsert_field_f_int ! !------------------------------------------------------------------------- -subroutine h5tbinsert_field_f_float(loc_id,& +SUBROUTINE h5tbinsert_field_f_float(loc_id,& dset_name,& field_name,& field_type,& field_index,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1462,45 +1470,45 @@ subroutine h5tbinsert_field_f_float(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - real, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code - interface - integer function h5tbinsert_field_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbinsert_field_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBINSERT_FIELD_FL_C'::h5tbinsert_field_fl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - real, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length length - end function h5tbinsert_field_fl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + REAL, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length length + END FUNCTION h5tbinsert_field_fl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbinsert_field_fl_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) -end subroutine h5tbinsert_field_f_float +END SUBROUTINE h5tbinsert_field_f_float @@ -1519,14 +1527,14 @@ end subroutine h5tbinsert_field_f_float ! !------------------------------------------------------------------------- -subroutine h5tbinsert_field_f_double(loc_id,& +SUBROUTINE h5tbinsert_field_f_double(loc_id,& dset_name,& field_name,& field_type,& field_index,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1535,45 +1543,45 @@ subroutine h5tbinsert_field_f_double(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code - interface - integer function h5tbinsert_field_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbinsert_field_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBINSERT_FIELD_DL_C'::h5tbinsert_field_dl_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - double precision, intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length length - end function h5tbinsert_field_dl_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + DOUBLE PRECISION, INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length length + END FUNCTION h5tbinsert_field_dl_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbinsert_field_dl_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) -end subroutine h5tbinsert_field_f_double +END SUBROUTINE h5tbinsert_field_f_double @@ -1593,14 +1601,14 @@ end subroutine h5tbinsert_field_f_double ! !------------------------------------------------------------------------- -subroutine h5tbinsert_field_f_string(loc_id,& +SUBROUTINE h5tbinsert_field_f_string(loc_id,& dset_name,& field_name,& field_type,& field_index,& buf,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1609,45 +1617,45 @@ subroutine h5tbinsert_field_f_string(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code - interface - integer function h5tbinsert_field_st_c(loc_id,namelen,dset_name,namelen1,field_name,& + INTERFACE + INTEGER FUNCTION h5tbinsert_field_st_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBINSERT_FIELD_ST_C'::h5tbinsert_field_st_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer(hid_t), intent(in) :: field_type ! field type - integer, intent(in) :: field_index ! field_index - character(len=*), intent(in), dimension(*) :: buf ! data buffer - integer :: namelen ! name length - integer :: namelen1 ! name length length - end function h5tbinsert_field_st_c - end interface - - namelen = len(dset_name) - namelen1 = len(field_name) + 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) :: field_name ! name of the field + INTEGER(hid_t), INTENT(in) :: field_type ! field type + INTEGER, INTENT(in) :: field_index ! field_index + CHARACTER(LEN=*), INTENT(in), DIMENSION(*) :: buf ! data buffer + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length length + END FUNCTION h5tbinsert_field_st_c + END INTERFACE + + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbinsert_field_st_c(loc_id,namelen,dset_name,namelen1,field_name,& field_type,field_index,buf) -end subroutine h5tbinsert_field_f_string +END SUBROUTINE h5tbinsert_field_f_string @@ -1667,11 +1675,11 @@ end subroutine h5tbinsert_field_f_string ! !------------------------------------------------------------------------- -subroutine h5tbdelete_field_f(loc_id,& +SUBROUTINE h5tbdelete_field_f(loc_id,& dset_name,& field_name,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1680,37 +1688,37 @@ subroutine h5tbdelete_field_f(loc_id,& !DEC$endif ! - 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) :: field_name ! name of the field - integer :: namelen ! name length - integer :: namelen1 ! name length - integer :: errcode ! error code + 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) :: field_name ! name of the field + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length + INTEGER :: errcode ! error code - interface - integer function h5tbdelete_field_c(loc_id,namelen,dset_name,namelen1,field_name) + INTERFACE + INTEGER FUNCTION h5tbdelete_field_c(loc_id,namelen,dset_name,namelen1,field_name) - use h5global + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBDELETE_FIELD_C'::h5tbdelete_field_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name !DEC$ATTRIBUTES reference :: field_name - 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) :: field_name ! name of the field - integer :: namelen ! name length - integer :: namelen1 ! name length length - end function h5tbdelete_field_c - end interface + 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) :: field_name ! name of the field + INTEGER :: namelen ! name length + INTEGER :: namelen1 ! name length length + END FUNCTION h5tbdelete_field_c + END INTERFACE - namelen = len(dset_name) - namelen1 = len(field_name) + namelen = LEN(dset_name) + namelen1 = LEN(field_name) errcode = h5tbdelete_field_c(loc_id,namelen,dset_name,namelen1,field_name) -end subroutine h5tbdelete_field_f +END SUBROUTINE h5tbdelete_field_f @@ -1731,13 +1739,13 @@ end subroutine h5tbdelete_field_f ! !------------------------------------------------------------------------- -subroutine h5tbget_table_info_f(loc_id,& +SUBROUTINE h5tbget_table_info_f(loc_id,& dset_name,& nfields,& nrecords,& errcode ) - implicit none + IMPLICIT NONE ! !This definition is needed for Windows DLLs @@ -1746,32 +1754,32 @@ subroutine h5tbget_table_info_f(loc_id,& !DEC$endif ! - 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(inout):: nfields ! nfields - integer(hsize_t), intent(inout):: nrecords ! nrecords - integer :: errcode ! error code - integer :: namelen ! name length + 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(inout):: nfields ! nfields + INTEGER(hsize_t), INTENT(inout):: nrecords ! nrecords + INTEGER :: errcode ! error code + INTEGER :: namelen ! name length - interface - integer function h5tbget_table_info_c(loc_id,namelen,dset_name,nfields,nrecords) - use h5global + INTERFACE + INTEGER FUNCTION h5tbget_table_info_c(loc_id,namelen,dset_name,nfields,nrecords) + USE h5global !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBGET_TABLE_INFO_C'::h5tbget_table_info_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: dset_name - 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(inout):: nfields ! nfields - integer(hsize_t), intent(inout):: nrecords ! nrecords - integer :: namelen ! name length - end function h5tbget_table_info_c - end interface - - namelen = len(dset_name) + 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(inout):: nfields ! nfields + INTEGER(hsize_t), INTENT(inout):: nrecords ! nrecords + INTEGER :: namelen ! name length + END FUNCTION h5tbget_table_info_c + END INTERFACE + + namelen = LEN(dset_name) errcode = h5tbget_table_info_c(loc_id,namelen,dset_name,nfields,nrecords) -end subroutine h5tbget_table_info_f +END SUBROUTINE h5tbget_table_info_f !------------------------------------------------------------------------- @@ -1787,75 +1795,81 @@ end subroutine h5tbget_table_info_f ! ! Comments: ! -! Modifications: +! Modifications: +! Added optional parameter for returning the maximum character lenght +! in the field name array. March 3, 2011 ! !------------------------------------------------------------------------- -subroutine h5tbget_field_info_f(loc_id,& +SUBROUTINE h5tbget_field_info_f(loc_id,& dset_name,& nfields,& field_names,& - field_sizes,& - field_offsets,& - type_size,& - errcode ) - - implicit none + field_sizes,& + field_offsets,& + type_size,& + errcode, maxlen_out ) + IMPLICIT NONE ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5tbget_field_info_f !DEC$endif ! - - 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 ! nfields - character(len=*), dimension(nfields), intent(inout) :: field_names ! field names - integer(size_t), dimension(nfields), intent(inout) :: field_sizes ! field sizes - integer(size_t), dimension(nfields), intent(inout) :: field_offsets ! field offsets - integer(size_t), intent(inout):: type_size ! type size - integer :: errcode ! error code - integer :: namelen ! name length - integer, dimension(nfields) :: namelen2 ! name lengths - integer :: i ! general purpose integer - - interface - integer function h5tbget_field_info_c(loc_id,namelen,dset_name,nfields,& - field_sizes,field_offsets,type_size,namelen2,field_names) - - use h5global - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBGET_FIELD_INFO_C'::h5tbget_field_info_c - !DEC$ENDIF - !DEC$ATTRIBUTES reference :: dset_name - 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 ! nfields - character(len=*), dimension(nfields), intent(inout) :: field_names ! field names - integer(size_t), dimension(nfields), intent(inout) :: field_sizes ! field sizes - integer(size_t), dimension(nfields), intent(inout) :: field_offsets ! field offsets - integer(size_t), intent(inout):: type_size ! type size - integer :: namelen ! name length - integer, dimension(nfields) :: namelen2 ! name lengths - end function h5tbget_field_info_c - end interface - - namelen = len(dset_name) - do i = 1, nfields - namelen2(i) = len(field_names(i)); - end do - errcode = h5tbget_field_info_c(loc_id,namelen,dset_name,nfields,& - field_sizes,field_offsets,type_size,namelen2,field_names) - -end subroutine h5tbget_field_info_f - - - -! end -! -end module H5TB + 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 ! nfields + CHARACTER(LEN=*), DIMENSION(nfields), INTENT(inout) :: field_names ! field names + INTEGER(size_t), DIMENSION(nfields), INTENT(inout) :: field_sizes ! field sizes + INTEGER(size_t), DIMENSION(nfields), INTENT(inout) :: field_offsets ! field offsets + INTEGER(size_t), INTENT(inout):: type_size ! type size + INTEGER :: errcode ! error code + INTEGER, OPTIONAL :: maxlen_out ! maximum character len of the field names + INTEGER :: namelen ! name length + INTEGER, DIMENSION(nfields) :: namelen2 ! name lengths + INTEGER :: i ! general purpose integer + INTEGER :: maxlen + INTEGER :: c_maxlen_out + + INTERFACE + INTEGER FUNCTION h5tbget_field_info_c(loc_id,namelen,dset_name,nfields,& + field_sizes,field_offsets,type_size,namelen2, maxlen, field_names, c_maxlen_out) + + USE h5global + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TBGET_FIELD_INFO_C'::h5tbget_field_info_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: dset_name + 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 ! nfields + CHARACTER(LEN=*), DIMENSION(1:nfields), INTENT(inout) :: field_names ! field names + INTEGER(size_t), DIMENSION(1:nfields), INTENT(inout) :: field_sizes ! field sizes + INTEGER(size_t), DIMENSION(1:nfields), INTENT(inout) :: field_offsets ! field offsets + INTEGER(size_t), INTENT(inout):: type_size ! type size + INTEGER :: namelen ! name length + INTEGER :: maxlen ! maxiumum length of input field names + INTEGER, DIMENSION(1:nfields) :: namelen2 ! name lengths + INTEGER :: c_maxlen_out ! maximum character length of a field array element + END FUNCTION h5tbget_field_info_c + END INTERFACE + + namelen = LEN(dset_name) + DO i = 1, nfields + namelen2(i) = LEN_TRIM(field_names(i)) + END DO + + maxlen = LEN(field_names(1)) + + errcode = h5tbget_field_info_c(loc_id, namelen,dset_name, nfields, & + field_sizes, field_offsets, type_size, namelen2, maxlen, field_names, c_maxlen_out) + + IF(PRESENT(maxlen_out)) maxlen_out = c_maxlen_out + +END SUBROUTINE h5tbget_field_info_f + +END MODULE H5TB diff --git a/hl/fortran/test/tsttable.f90 b/hl/fortran/test/tsttable.f90 index a6ce27f..8191693 100755 --- a/hl/fortran/test/tsttable.f90 +++ b/hl/fortran/test/tsttable.f90 @@ -17,420 +17,436 @@ ! This file contains the FORTRAN90 tests for H5LT ! -program table_test +PROGRAM table_test -call test_table1() + CALL test_table1() -end program table_test +END PROGRAM table_test !------------------------------------------------------------------------- ! test_table1 !------------------------------------------------------------------------- -subroutine test_table1() - -use H5TB ! module of H5TB -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=6), dimension(nfields) :: field_names ! field names -integer(SIZE_T), dimension(nfields) :: field_offset ! field offset -integer(HID_T), dimension(nfields) :: field_types ! field types -integer(HSIZE_T), parameter :: chunk_size = 5 ! chunk size -integer, parameter :: compress = 0 ! compress -integer :: errcode ! Error flag -integer :: i ! general purpose integer -integer(SIZE_T) :: type_size ! Size of the datatype -integer(SIZE_T) :: type_sizec ! Size of the character datatype -integer(SIZE_T) :: type_sizei ! Size of the integer datatype -integer(SIZE_T) :: type_sized ! Size of the double precision datatype -integer(SIZE_T) :: type_sizer ! Size of the real datatype -integer(HID_T) :: type_id_c ! Memory datatype identifier (for character field) -integer(SIZE_T) :: offset ! Member's offset -integer(HSIZE_T) :: start = 0 ! start record -integer, dimension(nrecords) :: bufi ! Data buffer -integer, dimension(nrecords) :: bufir ! Data buffer -real, dimension(nrecords) :: bufr ! Data buffer -real, dimension(nrecords) :: bufrr ! Data buffer -double precision, dimension(nrecords) :: bufd ! Data buffer -double precision, dimension(nrecords) :: bufdr ! Data buffer -character(LEN=2), dimension(nrecords), parameter :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer -character(LEN=2), dimension(nrecords) :: bufsr ! Data buffer -integer(HSIZE_T) :: nfieldsr ! nfields -integer(HSIZE_T) :: nrecordsr ! nrecords -character(LEN=6), dimension(nfields) :: field_namesr ! field names -integer(SIZE_T), dimension(nfields) :: field_offsetr ! field offset -integer(SIZE_T), dimension(nfields) :: field_sizesr ! field sizes -integer(SIZE_T) :: type_sizeout ! size of the datatype +SUBROUTINE test_table1() + + USE H5TB ! module of H5TB + 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 + 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 + INTEGER, PARAMETER :: compress = 0 ! compress + INTEGER :: errcode ! Error flag + INTEGER :: i ! general purpose integer + INTEGER(SIZE_T) :: type_size ! Size of the datatype + INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(HID_T) :: type_id_c ! Memory datatype identifier (for character field) + INTEGER(SIZE_T) :: offset ! Member's offset + INTEGER(HSIZE_T) :: start = 0 ! start record + INTEGER, DIMENSION(nrecords) :: bufi ! Data buffer + INTEGER, DIMENSION(nrecords) :: bufir ! Data buffer + REAL, DIMENSION(nrecords) :: bufr ! Data buffer + REAL, DIMENSION(nrecords) :: bufrr ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufd ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufdr ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords), PARAMETER :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords) :: bufsr ! Data buffer + INTEGER(HSIZE_T) :: nfieldsr ! nfields + INTEGER(HSIZE_T) :: nrecordsr ! nrecords + CHARACTER(LEN=9), DIMENSION(1:nfields) :: field_namesr ! field names + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offsetr ! field offset + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_sizesr ! field sizes + INTEGER(SIZE_T) :: type_sizeout ! size of the datatype + INTEGER :: maxlen ! max chararter length of a field name + + + ! + ! Initialize the data arrays. + ! + DO i = 1, nrecords + bufi(i) = i + bufr(i) = i + bufd(i) = i + 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) + + + !------------------------------------------------------------------------- + ! make table + ! initialize the table parameters + !------------------------------------------------------------------------- + + field_names(1) = "field1" + field_names(2) = "field2a" + field_names(3) = "field3ab" + field_names(4) = "field4abc" + + ! + ! calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) + type_size = 2 + CALL h5tset_size_f(type_id_c, type_size, errcode) + CALL h5tget_size_f(type_id_c, type_sizec, errcode) + CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) + CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) + CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) + type_size = type_sizec + type_sizei + type_sized + type_sizer + + ! + ! type ID's + ! + field_types(1) = type_id_c + field_types(2) = H5T_NATIVE_INTEGER + field_types(3) = H5T_NATIVE_DOUBLE + field_types(4) = H5T_NATIVE_REAL + + ! + ! offsets + ! + offset = 0 + field_offset(1) = offset + offset = offset + type_sizec ! Offset of the second memeber is 2 + field_offset(2) = offset + offset = offset + type_sizei ! Offset of the second memeber is 6 + field_offset(3) = offset + offset = offset + type_sized ! Offset of the second memeber is 14 + field_offset(4) = offset + + !------------------------------------------------------------------------- + ! make table + !------------------------------------------------------------------------- + + CALL test_begin(' Make table ') + + CALL h5tbmake_table_f(dsetname1,& + file_id,& + dsetname1,& + nfields,& + nrecords,& + type_size,& + field_names,& + field_offset,& + field_types,& + chunk_size,& + compress,& + errcode ) + + CALL passed() + + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by name ') + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufr,errcode) + + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufsr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufir,errcode) + + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufdr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufrr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO + + + CALL passed() + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by index ') + + CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufr,errcode) + + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + CALL h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufsr,errcode) -! -! Initialize the data arrays. -! -do i = 1, nrecords - bufi(i) = i; - bufr(i) = i; - bufd(i) = i; -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) - - -!------------------------------------------------------------------------- -! make table -! initialize the table parameters -!------------------------------------------------------------------------- - -field_names(1) = "field1" -field_names(2) = "field2" -field_names(3) = "field3" -field_names(4) = "field4" - -! -! calculate total size by calculating sizes of each member -! -call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) -type_size = 2 -call h5tset_size_f(type_id_c, type_size, errcode) -call h5tget_size_f(type_id_c, type_sizec, errcode) -call h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) -call h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) -call h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) -type_size = type_sizec + type_sizei + type_sized + type_sizer - -! -! type ID's -! -field_types(1) = type_id_c -field_types(2) = H5T_NATIVE_INTEGER -field_types(3) = H5T_NATIVE_DOUBLE -field_types(4) = H5T_NATIVE_REAL - -! -! offsets -! -offset = 0 -field_offset(1) = offset -offset = offset + type_sizec ! Offset of the second memeber is 2 -field_offset(2) = offset -offset = offset + type_sizei ! Offset of the second memeber is 6 -field_offset(3) = offset -offset = offset + type_sized ! Offset of the second memeber is 14 -field_offset(4) = offset - -!------------------------------------------------------------------------- -! make table -!------------------------------------------------------------------------- - -call test_begin(' Make table ') - - -call h5tbmake_table_f(dsetname1,& - file_id,& - dsetname1,& - nfields,& - nrecords,& - type_size,& - field_names,& - field_offset,& - field_types,& - chunk_size,& - compress,& - errcode ) - -call passed() - -!------------------------------------------------------------------------- -! write field -!------------------------------------------------------------------------- - -call test_begin(' Read/Write field by name ') - -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufs,errcode) - -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufi,errcode) - -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufd,errcode) - -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufr,errcode) - - - -!------------------------------------------------------------------------- -! read field -!------------------------------------------------------------------------- - -call h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufsr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufsr(i) .ne. bufs(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufsr(i), ' and ', bufs(i) - stop - endif -end do - -call h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufir,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufir(i) .ne. bufi(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufir(i), ' and ', bufi(i) - stop - endif -end do - -call h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufdr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufdr(i) .ne. bufd(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufdr(i), ' and ', bufd(i) - stop - endif -end do - -call h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufrr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do - - -call passed() - - -!------------------------------------------------------------------------- -! write field -!------------------------------------------------------------------------- - -call test_begin(' Read/Write field by index ') - -call h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufs,errcode) - -call h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufi,errcode) - -call h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufd,errcode) - -call h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufr,errcode) - - - -!------------------------------------------------------------------------- -! read field -!------------------------------------------------------------------------- - -call h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufsr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufsr(i) .ne. bufs(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufsr(i), ' and ', bufs(i) - stop - endif -end do + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO -call h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufir,errcode) + CALL h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufir,errcode) -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufir(i) .ne. bufi(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufir(i), ' and ', bufi(i) - stop - endif -end do + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO -call h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufdr,errcode) + CALL h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufdr,errcode) -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufdr(i) .ne. bufd(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufdr(i), ' and ', bufd(i) - stop - endif -end do + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO -call h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufrr,errcode) + CALL h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufrr,errcode) -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO -call passed() + CALL passed() -!------------------------------------------------------------------------- -! Insert field -! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) -!------------------------------------------------------------------------- - -call test_begin(' Insert field ') - -call h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) + !------------------------------------------------------------------------- + ! Insert field + ! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) + !------------------------------------------------------------------------- -call h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& - bufrr,errcode) -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do -call passed() + CALL test_begin(' Insert field ') + 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,& + bufrr,errcode) + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO -!------------------------------------------------------------------------- -! Delete field -!------------------------------------------------------------------------- -call test_begin(' Delete field ') + CALL passed() -call h5tbdelete_field_f(file_id,dsetname1,"field4",errcode) + !------------------------------------------------------------------------- + ! Delete field + !------------------------------------------------------------------------- -call passed() + CALL test_begin(' Delete field ') + CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode) -!------------------------------------------------------------------------- -! Gets the number of records and fields -!------------------------------------------------------------------------- + CALL passed() -call test_begin(' Get table info ') -call h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) + !------------------------------------------------------------------------- + ! Gets the number of records and fields + !------------------------------------------------------------------------- -if ( nfieldsr .ne. nfields .and. nrecordsr .ne. nrecords ) then - print *, 'h5tbget_table_info_f return error' - stop -endif + CALL test_begin(' Get table info ') -call passed() + CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) + IF ( nfieldsr .NE. nfields .AND. nrecordsr .NE. nrecords ) THEN + PRINT *, 'h5tbget_table_info_f return error' + STOP + ENDIF -!------------------------------------------------------------------------- -! Get information about fields -!------------------------------------------------------------------------- + CALL passed() -!call test_begin(' Get fields info ') -!call h5tbget_field_info_f(file_id,dsetname1,nfields,field_namesr,field_sizesr,& -! field_offsetr,type_sizeout,errcode ) + !------------------------------------------------------------------------- + ! Get information about fields + !------------------------------------------------------------------------- + CALL test_begin(' Get fields info ') -!call passed() + CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,& + field_offsetr, type_sizeout, errcode, maxlen ) + IF ( errcode.NE.0 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: RETURN ERROR")') + STOP + ENDIF + ! "field4abc" was deleted and "field5" was added. + field_names(4) = "field5" -!------------------------------------------------------------------------- -! end -!------------------------------------------------------------------------- + IF ( maxlen .NE. 8 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: INCORRECT MAXIMUM CHARACTER LENGTH OF THE FIELD NAMES")') + WRITE(*,'(5X,"RETURNED VALUE = ", I0, ", CORRECT VALUE = ", I0)') maxlen, 8 + STOP + ENDIF -! -! Close the file. -! -call h5fclose_f(file_id, errcode) + DO i = 1, nfields + IF ( field_namesr(i) .NE. field_names(i)) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: READ/WRITE FIELD NAMES DIFFER")') + WRITE(*,'(27X,A," AND ",A)') TRIM(field_namesr(i)), TRIM(field_names(i)) + STOP + ENDIF + END DO -! -! Close FORTRAN predefined datatypes. -! -call h5close_f(errcode) + CALL passed() -! -! end function. -! -end subroutine test_table1 + !------------------------------------------------------------------------- + ! end + !------------------------------------------------------------------------- + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + ! + ! end function. + ! +END SUBROUTINE test_table1 !------------------------------------------------------------------------- ! test_begin !------------------------------------------------------------------------- -subroutine test_begin(string) -character(LEN=*), intent(IN) :: string -write(*, fmt = '(14a)', advance = 'no') string -write(*, fmt = '(40x,a)', advance = 'no') ' ' -end subroutine test_begin +SUBROUTINE test_begin(string) + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(14a)', advance = 'no') string + WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' +END SUBROUTINE test_begin !------------------------------------------------------------------------- ! passed !------------------------------------------------------------------------- -subroutine passed() -write(*, fmt = '(6a)') 'PASSED' -end subroutine passed +SUBROUTINE passed() + WRITE(*, fmt = '(6a)') 'PASSED' +END SUBROUTINE passed |