diff options
| author | Dana Robinson <derobins@hdfgroup.org> | 2015-05-07 21:05:14 (GMT) |
|---|---|---|
| committer | Dana Robinson <derobins@hdfgroup.org> | 2015-05-07 21:05:14 (GMT) |
| commit | 984ecb72c2fa62d233383b24047e04061754ae34 (patch) | |
| tree | a0a1ce905153a08466dae1354e14d426c86b3849 /fortran | |
| parent | ed599421c5ef01347368d50b1b7dbed3b323c43f (diff) | |
| parent | 8f82c9b8be875cd28e18402e920f8e162d8f8d38 (diff) | |
| download | hdf5-984ecb72c2fa62d233383b24047e04061754ae34.zip hdf5-984ecb72c2fa62d233383b24047e04061754ae34.tar.gz hdf5-984ecb72c2fa62d233383b24047e04061754ae34.tar.bz2 | |
[svn-r27038] Merge of r26393-27031 from the trunk.
Tested on 64-bit linux VM w/ C++ and Fortran 2003
Diffstat (limited to 'fortran')
40 files changed, 1361 insertions, 1414 deletions
diff --git a/fortran/examples/CMakeLists.txt b/fortran/examples/CMakeLists.txt index 1f59f32..2bf0bf6 100644 --- a/fortran/examples/CMakeLists.txt +++ b/fortran/examples/CMakeLists.txt @@ -8,7 +8,7 @@ PROJECT (HDF5_F90_EXAMPLES C CXX Fortran) #----------------------------------------------------------------------------- # Setup include Directories #----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${CMAKE_Fortran_MODULE_DIRECTORY} ${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) +INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) #----------------------------------------------------------------------------- # Define Sources @@ -41,57 +41,52 @@ set (F2003_examples foreach (example ${examples}) add_executable (f90_ex_${example} ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) TARGET_NAMING (f90_ex_${example} ${LIB_TYPE}) - TARGET_FORTRAN_PROPERTIES (f90_ex_${example} " " " ") - if (WIN32) - set_property (TARGET f90_ex_${example} - APPEND PROPERTY COMPILE_DEFINITIONS - HDF5F90_WINDOWS - ) - endif (WIN32) + TARGET_FORTRAN_PROPERTIES (f90_ex_${example} ${LIB_TYPE} " " " ") target_link_libraries (f90_ex_${example} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} ) - set_target_properties (f90_ex_${example} PROPERTIES LINKER_LANGUAGE Fortran) - set_target_properties (f90_ex_${example} PROPERTIES FOLDER examples/fortran) + target_include_directories (f90_ex_${example} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + set_target_properties (f90_ex_${example} PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} + ) endforeach (example ${examples}) if (HDF5_ENABLE_F2003) foreach (example ${F2003_examples}) add_executable (f03_ex_${example} ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) TARGET_NAMING (f03_ex_${example} ${LIB_TYPE}) - TARGET_FORTRAN_PROPERTIES (f03_ex_${example} " " " ") - if (WIN32) - set_property (TARGET f03_ex_${example} - APPEND PROPERTY COMPILE_DEFINITIONS HDF5F90_WINDOWS - ) - endif (WIN32) + TARGET_FORTRAN_PROPERTIES (f03_ex_${example} ${LIB_TYPE} " " " ") target_link_libraries (f03_ex_${example} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} ) - set_target_properties (f03_ex_${example} PROPERTIES LINKER_LANGUAGE Fortran) - set_target_properties (f03_ex_${example} PROPERTIES FOLDER examples/fortran03) + target_include_directories (f03_ex_${example} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + set_target_properties (f03_ex_${example} PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran03 + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} + ) endforeach (example ${F2003_examples}) endif (HDF5_ENABLE_F2003) if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) add_executable (f90_ex_ph5example ${HDF5_F90_EXAMPLES_SOURCE_DIR}/ph5example.f90) TARGET_NAMING (f90_ex_ph5example ${LIB_TYPE}) - TARGET_FORTRAN_PROPERTIES (f90_ex_ph5example " " " ") - if (WIN32) - set_property (TARGET f90_ex_ph5example - APPEND PROPERTY COMPILE_DEFINITIONS - HDF5F90_WINDOWS - ) - endif (WIN32) + TARGET_FORTRAN_PROPERTIES (f90_ex_ph5example ${LIB_TYPE} " " " ") target_link_libraries (f90_ex_ph5example ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} ${MPI_Fortran_LIBRARIES} ) - set_target_properties (f90_ex_ph5example PROPERTIES LINKER_LANGUAGE Fortran) - set_target_properties (f90_ex_ph5example PROPERTIES FOLDER examples/fortran) + target_include_directories (f90_ex_ph5example PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + set_target_properties (f90_ex_ph5example PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} + ) endif (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) if (BUILD_TESTING) diff --git a/fortran/examples/Makefile.am b/fortran/examples/Makefile.am index feed32c..caaa08c 100644 --- a/fortran/examples/Makefile.am +++ b/fortran/examples/Makefile.am @@ -79,6 +79,7 @@ endif # Tell automake how to install examples # Note: no '/' after DESTDIR. Explanation in commence.am EXAMPLEDIR=${DESTDIR}$(exec_prefix)/share/hdf5_examples/fortran +EXAMPLETOPDIR=${DESTDIR}$(exec_prefix)/share/hdf5_examples # List dependencies for each example. Normally, automake would take # care of this for us, but if we tell automake about the programs it diff --git a/fortran/examples/run-fortran-ex.sh.in b/fortran/examples/run-fortran-ex.sh.in index ead7361..a4d4550 100644 --- a/fortran/examples/run-fortran-ex.sh.in +++ b/fortran/examples/run-fortran-ex.sh.in @@ -34,7 +34,7 @@ EXIT_FAILURE=1 # Where the tool is installed. # default is relative path to installed location of the tools -prefix="${prefix:-../../../}" +prefix="${prefix:-@prefix@}" PARALLEL=@PARALLEL@ # Am I in parallel mode? AR="@AR@" RANLIB="@RANLIB@" diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index 22a091e..c015072 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -54,7 +54,10 @@ if (WIN32 AND MSVC) LINK_FLAGS "/SUBSYSTEM:CONSOLE" ) endif (WIN32 AND MSVC) -set_target_properties (H5test_FortranHavekind PROPERTIES LINKER_LANGUAGE Fortran) +set_target_properties (H5test_FortranHavekind PROPERTIES + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} +) set (CMD $<TARGET_FILE:H5test_FortranHavekind>) add_custom_command ( @@ -142,7 +145,7 @@ set (f90CStub_C_HDRS ) add_library (${HDF5_F90_C_LIB_TARGET} ${LIB_TYPE} ${f90CStub_C_SRCS} ${f90CStub_C_HDRS}) -TARGET_C_PROPERTIES (${HDF5_F90_C_LIB_TARGET} " " " ") +TARGET_C_PROPERTIES (${HDF5_F90_C_LIB_TARGET} ${LIB_TYPE} " " " ") target_link_libraries (${HDF5_F90_C_LIB_TARGET} ${HDF5_LIB_TARGET} ${LINK_LIBS}) set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_C_LIB_TARGET}") H5_SET_LIB_OPTIONS (${HDF5_F90_C_LIB_TARGET} ${HDF5_F90_C_LIB_NAME} ${LIB_TYPE}) @@ -247,8 +250,7 @@ if (WIN32) HDF5F90_WINDOWS ) endif (WIN32) -TARGET_FORTRAN_PROPERTIES (${HDF5_F90_LIB_TARGET} " " ${SHARED_LINK_FLAGS}) -set_target_properties (${HDF5_F90_LIB_TARGET} PROPERTIES LINKER_LANGUAGE Fortran) +TARGET_FORTRAN_PROPERTIES (${HDF5_F90_LIB_TARGET} ${LIB_TYPE} " " ${SHARED_LINK_FLAGS}) target_link_libraries (${HDF5_F90_LIB_TARGET} ${HDF5_F90_C_LIB_TARGET} ${HDF5_LIB_TARGET}) if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) target_link_libraries (${HDF5_F90_LIB_TARGET} ${MPI_Fortran_LIBRARIES}) @@ -259,6 +261,7 @@ set_target_properties (${HDF5_F90_LIB_TARGET} PROPERTIES FOLDER libraries/fortran LINKER_LANGUAGE Fortran INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} ) #----------------------------------------------------------------------------- @@ -278,100 +281,50 @@ install ( ) if (WIN32) - install ( - FILES - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5fortran_types.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/hdf5.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5global.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5a.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5d.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5e.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5f.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5g.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5i.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5l.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5lib.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5o.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5p.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5r.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5s.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5t.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5z.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5a_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5d_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5e_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5f_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5l_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5lib_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5o_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5p_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5r_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5t_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/h5_dble_interface.mod - DESTINATION - ${HDF5_INSTALL_INCLUDE_DIR} - COMPONENT - fortheaders - ) - if (H5_TEST_KIND_NAME) - install ( - FILES - ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}/${H5_TEST_KIND_NAME}.mod - DESTINATION - ${HDF5_INSTALL_INCLUDE_DIR} - COMPONENT - fortheaders - ) - endif (H5_TEST_KIND_NAME) + set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/\${BUILD_TYPE}) else (WIN32) - install ( - FILES - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5fortran_types.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/hdf5.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5global.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5f.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5a.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5d.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5e.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5f.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5g.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5i.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5l.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5lib.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5o.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5p.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5r.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5s.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5t.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5z.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5a_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5d_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5e_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5f_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5l_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5lib_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5o_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5p_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5r_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5t_provisional.mod - ${CMAKE_Fortran_MODULE_DIRECTORY}/h5_dble_interface.mod - DESTINATION - ${HDF5_INSTALL_INCLUDE_DIR} - COMPONENT - fortheaders - ) - if (H5_TEST_KIND_NAME) - install ( - FILES - ${CMAKE_Fortran_MODULE_DIRECTORY}/${H5_TEST_KIND_NAME}.mod - DESTINATION - ${HDF5_INSTALL_INCLUDE_DIR} - COMPONENT - fortheaders - ) - endif (H5_TEST_KIND_NAME) + set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}) endif (WIN32) +set (mod_files + ${MOD_BUILD_DIR}/h5fortran_types.mod + ${MOD_BUILD_DIR}/hdf5.mod + ${MOD_BUILD_DIR}/h5global.mod + ${MOD_BUILD_DIR}/h5a.mod + ${MOD_BUILD_DIR}/h5d.mod + ${MOD_BUILD_DIR}/h5e.mod + ${MOD_BUILD_DIR}/h5f.mod + ${MOD_BUILD_DIR}/h5g.mod + ${MOD_BUILD_DIR}/h5i.mod + ${MOD_BUILD_DIR}/h5l.mod + ${MOD_BUILD_DIR}/h5lib.mod + ${MOD_BUILD_DIR}/h5o.mod + ${MOD_BUILD_DIR}/h5p.mod + ${MOD_BUILD_DIR}/h5r.mod + ${MOD_BUILD_DIR}/h5s.mod + ${MOD_BUILD_DIR}/h5t.mod + ${MOD_BUILD_DIR}/h5z.mod + ${MOD_BUILD_DIR}/h5a_provisional.mod + ${MOD_BUILD_DIR}/h5d_provisional.mod + ${MOD_BUILD_DIR}/h5e_provisional.mod + ${MOD_BUILD_DIR}/h5f_provisional.mod + ${MOD_BUILD_DIR}/h5l_provisional.mod + ${MOD_BUILD_DIR}/h5lib_provisional.mod + ${MOD_BUILD_DIR}/h5o_provisional.mod + ${MOD_BUILD_DIR}/h5p_provisional.mod + ${MOD_BUILD_DIR}/h5r_provisional.mod + ${MOD_BUILD_DIR}/h5t_provisional.mod + ${MOD_BUILD_DIR}/h5_dble_interface.mod +) +install ( + FILES + ${mod_files} + DESTINATION + ${HDF5_INSTALL_INCLUDE_DIR} + COMPONENT + fortheaders +) + #----------------------------------------------------------------------------- # Add Target(s) to CMake Install for import into other projects #----------------------------------------------------------------------------- diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index a108384..f4082a9 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -632,7 +632,7 @@ nh5dwrite_ref_obj_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_ * Allocate temporary buffer and copy references from Fortran. */ n = (unsigned int)*dims; - buf_c = (hobj_ref_t*)HDmalloc(sizeof(hobj_ref_t)*(n)); + buf_c = (hobj_ref_t*)HDmalloc(sizeof(hobj_ref_t)*n); if ( buf_c != NULL ) { for (i = 0; i < n; i++) HDmemcpy(&buf_c[i], &buf[i], sizeof(haddr_t)); @@ -699,7 +699,7 @@ nh5dwrite_ref_reg_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_ /* * Allocate temporary buffer and copy references from Fortran. */ - buf_c = (hdset_reg_ref_t *)HDmalloc(sizeof(hdset_reg_ref_t)*(n)); + buf_c = (hdset_reg_ref_t *)HDmalloc(sizeof(hdset_reg_ref_t)*n); if ( buf_c != NULL ) { for (i = 0; i < n; i++) { HDmemcpy(&buf_c[i], buf, H5R_DSET_REG_REF_BUF_SIZE); @@ -1722,7 +1722,7 @@ nh5dread_vl_integer_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_s max_len = (size_t)dims[0]; num_elem = H5Sget_select_npoints(c_mem_space_id); - if(num_elem != dims[1]) return ret_value; + if(num_elem != (hssize_t)dims[1]) return ret_value; c_buf = (hvl_t *)HDmalloc((size_t)num_elem * sizeof(hvl_t)); if (c_buf == NULL) return ret_value; @@ -2037,7 +2037,7 @@ nh5dread_vl_real_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_spac max_len = (size_t)dims[0]; num_elem = H5Sget_select_npoints(c_mem_space_id); - if(num_elem != dims[1]) return ret_value; + if(num_elem != (hssize_t)dims[1]) return ret_value; c_buf = (hvl_t *)HDmalloc((size_t)num_elem * sizeof(hvl_t)); if (c_buf == NULL) return ret_value; diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index 7455fca..1696672 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -632,7 +632,7 @@ nh5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen) /* * Call H5Fget_name function */ - if ((size_c = (size_t_f)H5Fget_name((hid_t)*obj_id, c_buf, (size_t)*buflen)) < 0) + if ((size_c = H5Fget_name((hid_t)*obj_id, c_buf, (size_t)*buflen)) < 0) HGOTO_DONE(FAIL); /* @@ -703,13 +703,16 @@ h5fget_file_image_c(hid_t_f *file_id, void *buf_ptr, size_t_f *buf_len, size_t_f /******/ { herr_t ret_value=0; /* Return value */ - + ssize_t c_buf_req; /* * Call h5fget_file_image function */ - if ((*buf_req = (size_t_f)H5Fget_file_image((hid_t)*file_id, buf_ptr, (size_t)*buf_len)) < 0) + + if ( (c_buf_req = H5Fget_file_image((hid_t)*file_id, buf_ptr, (size_t)*buf_len)) < 0) HGOTO_DONE(FAIL); + *buf_req = (size_t_f)c_buf_req; + done: return ret_value; } diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index ad3ea49..7f755b3 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -67,7 +67,7 @@ nh5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, /* * Call H5Gcreate function. */ - if(*size_hint == OBJECT_NAMELEN_DEFAULT_F ){ + if(*size_hint == (size_t_f)OBJECT_NAMELEN_DEFAULT_F ){ c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name,(hid_t)*lcpl_id,(hid_t)*gcpl_id,(hid_t)*gapl_id);} else { /* Create the group creation property list */ diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c index 7efa10a..6523ab4 100644 --- a/fortran/src/H5Lf.c +++ b/fortran/src/H5Lf.c @@ -677,9 +677,9 @@ done: /****if* H5Lf/h5lget_name_by_idx_c * NAME - * h5lget_name_by_idx_c + * h5lget_name_by_idx_c * PURPOSE - * Call H5Lget_name_by_idx + * Call H5Lget_name_by_idx * INPUTS * * loc_id - File or group identifier specifying location of subject group @@ -694,10 +694,10 @@ done: * name - Buffer in which link value is returned * size - The size of the link name on success * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * M. Scot Breitenfeld - * March 10, 2008 + * March 10, 2008 * SOURCE */ int_f @@ -706,9 +706,10 @@ nh5lget_name_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, size_t_f *size, _fcd name, hid_t_f *lapl_id) /******/ { - char *c_group_name = NULL; /* Buffer to hold C string */ + char *c_group_name = NULL; /* Buffer to hold C string */ char *c_name = NULL; /* Buffer to hold C string */ size_t c_size; + ssize_t c_size_link; int_f ret_value = 0; /* Return value */ /* @@ -725,10 +726,12 @@ nh5lget_name_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, if(NULL == (c_name = (char *)HDmalloc(c_size))) HGOTO_DONE(FAIL) - if((*size = (size_t_f)H5Lget_name_by_idx((hid_t)*loc_id, c_group_name, (H5_index_t)*index_field, + if((c_size_link = H5Lget_name_by_idx((hid_t)*loc_id, c_group_name, (H5_index_t)*index_field, (H5_iter_order_t)*order, (hsize_t)*n,c_name, c_size, (hid_t)*lapl_id)) < 0) HGOTO_DONE(FAIL) + *size = (size_t_f)c_size_link; + /* * Convert C name to FORTRAN and place it in the given buffer */ diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index ad8b7ed..ae344a5 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -23,6 +23,8 @@ #include "H5f90.h" #include "H5Eprivate.h" +int_f +fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info); int_f fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { @@ -874,6 +876,7 @@ nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, char *c_comment = NULL; /* Buffer to hold C string */ char *c_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ + ssize_t c_bufsize; size_t c_commentsize; /* @@ -895,9 +898,11 @@ nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, * Call H5Oget_comment_by_name function. */ - if((*bufsize = (size_t_f)H5Oget_comment_by_name((hid_t)*loc_id, c_name, c_comment, (size_t)*commentsize,(hid_t)*lapl_id )) < 0) + if((c_bufsize = H5Oget_comment_by_name((hid_t)*loc_id, c_name, c_comment, (size_t)*commentsize,(hid_t)*lapl_id )) < 0) HGOTO_DONE(FAIL); + *bufsize = (size_t_f)c_bufsize; + /* * Convert C name to FORTRAN and place it in the given buffer */ diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index fa4dc5b..e9082d6 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -160,41 +160,32 @@ done: /****if* H5Pf/h5pget_class_c * NAME - * h5pget_class_c + * h5pget_class_c * PURPOSE - * Call H5Pget_class to determine property list class + * Call H5Pget_class to determine property list class * INPUTS - * prp_id - identifier of the dataspace + * prp_id - identifier of the dataspace * OUTPUTS - * classtype - class type; possible values are: - * H5P_ROOT_F -1 - * H5P_FILE_CREATE_F 0 - * H5P_FILE_ACCESS_F 1 - * H5P_DATASET_CREATE_F 2 - * H5P_DATASET_XFER_F 3 - * H5P_FILE_MOUNT_F 4 + * classtype - class type * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * Elena Pourmal - * Saturday, August 14, 1999 + * Saturday, August 14, 1999 * SOURCE */ int_f -nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype) +nh5pget_class_c ( hid_t_f *prp_id , hid_t_f *classtype) /******/ { hid_t c_classtype; int_f ret_value = 0; - c_classtype = H5Pget_class((hid_t)*prp_id); - if(c_classtype == H5P_ROOT) { - *classtype = H5P_ROOT; + if( (c_classtype = H5Pget_class((hid_t)*prp_id)) < 0) HGOTO_DONE(FAIL) - } - *classtype = (int_f)c_classtype; + *classtype = (hid_t_f)c_classtype; done: return ret_value; diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 index 0d85252..3409f15 100644 --- a/fortran/src/H5Pff.f90 +++ b/fortran/src/H5Pff.f90 @@ -237,18 +237,10 @@ CONTAINS ! Returns the property list class for a property list. ! ! INPUTS -! ! prp_id - property list identifier +! ! OUTPUTS -! ! classtype - property list class -! Possible values are: -! H5P_ROOT_F -! H5P_FILE_CREATE_F -! H5P_FILE_ACCESS_F -! H5P_DATASET_CREATE_F -! H5P_DATASET_XFER_F -! H5P_FILE_MOUNT_F ! hdferr: - error code ! Success: 0 ! Failure: -1 @@ -265,30 +257,21 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(OUT) :: classtype ! The type of the property list - ! to be created. Possible values are: - ! H5P_ROOT_F - ! H5P_FILE_CREATE_F - ! H5P_FILE_ACCESS_F - ! H5P_DATASET_CREATE_F - ! H5P_DATASET_XFER_F - ! H5P_FILE_MOUNT_F + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(OUT) :: classtype ! The type of the property list + ! to be created. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** -! INTEGER, EXTERNAL :: h5pget_class_c -! MS FORTRAN needs explicit interface for C functions called here. -! INTERFACE INTEGER FUNCTION h5pget_class_c(prp_id, classtype) USE H5GLOBAL !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_CLASS_C'::h5pget_class_c !DEC$ENDIF - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(OUT) :: classtype + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(OUT) :: classtype END FUNCTION h5pget_class_c END INTERFACE @@ -1449,7 +1432,7 @@ CONTAINS !****s* H5P/h5pget_fapl_core_f ! NAME -! h5pget_fapl_core_f +! h5pget_fapl_core_f ! ! PURPOSE ! Queries core file driver properties. @@ -1487,9 +1470,6 @@ CONTAINS !***** INTEGER :: backing_store_flag -! INTEGER, EXTERNAL :: h5pget_fapl_core_c -! MS FORTRAN needs explicit interface for C functions called here. -! INTERFACE INTEGER FUNCTION h5pget_fapl_core_c(prp_id, increment, backing_store_flag) USE H5GLOBAL @@ -3644,7 +3624,7 @@ CONTAINS ! size - Actual length of the class name ! NOTE: If provided buffer "name" is smaller, ! than name will be truncated to fit into -! provided user buffer +! provided user buffer. ! hdferr: - error code ! Success: 0 ! Failure: -1 @@ -4222,50 +4202,46 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_fapl_multi_l(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_map ! Mapping array - INTEGER(HID_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_fapl ! Property list for each memory usage type - CHARACTER(LEN=*), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_name ! Names of member file - REAL, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_addr - LOGICAL, INTENT(IN) :: relax ! Flag - INTEGER, INTENT(OUT) :: hdferr ! Error code - ! 0 on success and -1 on failure + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, DIMENSION(*), INTENT(IN) :: memb_map + INTEGER(HID_T), DIMENSION(*), INTENT(IN) :: memb_fapl + CHARACTER(LEN=*), DIMENSION(*), INTENT(IN) :: memb_name + REAL, DIMENSION(*), INTENT(IN) :: memb_addr + LOGICAL, INTENT(IN) :: relax + INTEGER, INTENT(OUT) :: hdferr !***** - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: lenm + INTEGER, DIMENSION(1:H5FD_MEM_NTYPES_F) :: lenm INTEGER :: maxlen - INTEGER :: flag + INTEGER :: flag = 0 INTEGER :: i -! INTEGER, EXTERNAL :: h5pset_fapl_multi_c -! MS FORTRAN needs explicit interface for C functions called here. -! INTERFACE INTEGER FUNCTION h5pset_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, & maxlen, memb_addr, flag) USE H5GLOBAL + IMPLICIT NONE !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PSET_FAPL_MULTI_C'::h5pset_fapl_multi_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: memb_name INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_map - INTEGER(HID_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_fapl - CHARACTER(LEN=*), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_name - REAL, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(IN) :: memb_addr - !INTEGER(HADDR_T), DIMENSION(H5FD_MEM_NTYPES_F), INTENT(IN) :: memb_addr - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: lenm + INTEGER, DIMENSION(*), INTENT(IN) :: memb_map + INTEGER(HID_T), DIMENSION(*), INTENT(IN) :: memb_fapl + CHARACTER(LEN=*), DIMENSION(*), INTENT(IN) :: memb_name + REAL, DIMENSION(*), INTENT(IN) :: memb_addr + INTEGER, DIMENSION(*) :: lenm INTEGER :: maxlen INTEGER, INTENT(IN) :: flag END FUNCTION h5pset_fapl_multi_c END INTERFACE + maxlen = LEN(memb_name(1)) - DO i=0, H5FD_MEM_NTYPES_F-1 + DO i=1, H5FD_MEM_NTYPES_F lenm(i) = LEN_TRIM(memb_name(i)) ENDDO - flag = 0 - IF (relax) flag = 1 - hdferr = h5pset_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag) - + IF(relax) flag = 1 + hdferr = h5pset_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag) + END SUBROUTINE h5pset_fapl_multi_l !****s* H5P/h5pset_fapl_multi_s ! NAME @@ -4303,6 +4279,7 @@ CONTAINS INTERFACE INTEGER FUNCTION h5pset_fapl_multi_sc(prp_id,flag) USE H5GLOBAL + IMPLICIT NONE !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PSET_FAPL_MULTI_SC'::h5pset_fapl_multi_sc !DEC$ENDIF @@ -4346,51 +4323,50 @@ CONTAINS SUBROUTINE h5pget_fapl_multi_f(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr, maxlen_out) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_map - INTEGER(HID_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_fapl - CHARACTER(LEN=*), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_name - !INTEGER(HADDR_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_addr - REAL, DIMENSION(0:H5FD_MEM_NTYPES_F-1), INTENT(OUT) :: memb_addr + INTEGER, DIMENSION(*), INTENT(OUT) :: memb_map + INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: memb_fapl + CHARACTER(LEN=*), DIMENSION(*), INTENT(OUT) :: memb_name + REAL, DIMENSION(*), INTENT(OUT) :: memb_addr INTEGER, OPTIONAL, INTENT(OUT) :: maxlen_out LOGICAL, INTENT(OUT) :: relax INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: lenm + INTEGER, DIMENSION(1:H5FD_MEM_NTYPES_F) :: lenm INTEGER :: maxlen INTEGER :: c_maxlen_out INTEGER :: flag INTEGER :: i - -! INTEGER, EXTERNAL :: h5pget_fapl_multi_c -! MS FORTRAN needs explicit interface for C functions called here. ! INTERFACE INTEGER FUNCTION h5pget_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, & maxlen, memb_addr, flag, c_maxlen_out) USE H5GLOBAL + IMPLICIT NONE !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_FAPL_MULTI_C'::h5pget_fapl_multi_c !DEC$ENDIF !DEC$ATTRIBUTES reference :: memb_name INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier - INTEGER, DIMENSION(H5FD_MEM_NTYPES_F), INTENT(OUT) :: memb_map - INTEGER(HID_T), DIMENSION(H5FD_MEM_NTYPES_F), INTENT(OUT) :: memb_fapl - CHARACTER(LEN=*), DIMENSION(H5FD_MEM_NTYPES_F), INTENT(OUT) :: memb_name - REAL, DIMENSION(H5FD_MEM_NTYPES_F), INTENT(OUT) :: memb_addr - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: lenm + INTEGER, DIMENSION(*), INTENT(OUT) :: memb_map + INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: memb_fapl + CHARACTER(LEN=*), DIMENSION(*), INTENT(OUT) :: memb_name + REAL, DIMENSION(*), INTENT(OUT) :: memb_addr + INTEGER, DIMENSION(*) :: lenm INTEGER :: maxlen INTEGER :: c_maxlen_out INTEGER, INTENT(OUT) :: flag END FUNCTION h5pget_fapl_multi_c END INTERFACE - maxlen = LEN(memb_name(0)) - DO i=0, H5FD_MEM_NTYPES_F-1 + + maxlen = LEN(memb_name(1)) + DO i=1, H5FD_MEM_NTYPES_F lenm(i) = LEN_TRIM(memb_name(i)) ENDDO - hdferr = h5pget_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag, c_maxlen_out) + hdferr = h5pget_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag, c_maxlen_out) + relax = .TRUE. - IF(flag .EQ. 0) relax = .FALSE. + IF(flag .EQ. 0) relax = .FALSE. IF(PRESENT(maxlen_out)) maxlen_out = c_maxlen_out END SUBROUTINE h5pget_fapl_multi_f !****s* H5P/h5pset_szip_f diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c index 19fa6b1..068f24e 100644 --- a/fortran/src/H5Rf.c +++ b/fortran/src/H5Rf.c @@ -148,13 +148,11 @@ h5rcreate_ptr_c (void *ref, hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *r { int ret_value = -1; char *c_name; - size_t c_namelen; /* * Convert FORTRAN name to C name */ - c_namelen = (size_t)*namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; /* diff --git a/fortran/src/H5Rff_F03.f90 b/fortran/src/H5Rff_F03.f90 index fc4b2f3..8f40607 100644 --- a/fortran/src/H5Rff_F03.f90 +++ b/fortran/src/H5Rff_F03.f90 @@ -14,18 +14,18 @@ ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the files COPYING and Copyright.html. COPYING can be found at the root * -! of the source code distribution tree; Copyright.html can be found at the * -! root level of an installed copy of the electronic HDF5 document set and * -! is linked from the top-level documents page. It can also be found at * -! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * -! access to either file, you may request a copy from help@hdfgroup.org. * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! NOTES @@ -551,7 +551,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hobj_ref_t_f), INTENT(IN), TARGET :: ref INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size - CHARACTER(LEN=*), INTENT(OUT) :: name + CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr !***** @@ -598,7 +598,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hdset_reg_ref_t_f), INTENT(IN), TARGET :: ref INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size - CHARACTER(LEN=*), INTENT(OUT) :: name + CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr !***** INTEGER(SIZE_T) :: size_default @@ -647,7 +647,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER, INTENT(IN) :: ref_type TYPE(C_PTR), INTENT(IN) :: ref - CHARACTER(LEN=*), INTENT(OUT) :: name + CHARACTER(LEN=*), INTENT(INOUT) :: name INTEGER, INTENT(OUT) :: hdferr INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size !***** diff --git a/fortran/src/H5Rff_F90.f90 b/fortran/src/H5Rff_F90.f90 index 3871d99..ac45857 100644 --- a/fortran/src/H5Rff_F90.f90 +++ b/fortran/src/H5Rff_F90.f90 @@ -14,18 +14,18 @@ ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the files COPYING and Copyright.html. COPYING can be found at the root * -! of the source code distribution tree; Copyright.html can be found at the * -! root level of an installed copy of the electronic HDF5 document set and * -! is linked from the top-level documents page. It can also be found at * -! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * -! access to either file, you may request a copy from help@hdfgroup.org. * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! NOTES diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c index f6803ac..6947d64 100644 --- a/fortran/src/H5Sf.c +++ b/fortran/src/H5Sf.c @@ -298,7 +298,7 @@ nh5sget_select_hyper_blocklist_c( hid_t_f *space_id ,hsize_t_f *startblock, if (rank < 0 ) return ret_value; c_startblock = (hsize_t)*startblock; - c_buf = (hsize_t*)HDmalloc(sizeof(hsize_t)*(size_t)(c_num_blocks*2*rank)); + c_buf = (hsize_t*)HDmalloc(sizeof(hsize_t)*(size_t)(c_num_blocks*2*(hsize_t)rank)); if (!c_buf) return ret_value; ret_value = H5Sget_select_hyper_blocklist(c_space_id, c_startblock, @@ -425,7 +425,7 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, if (rank < 0 ) return ret_value; c_startpoint = (hsize_t)*startpoint; - c_buf = (hsize_t*)HDmalloc(sizeof(hsize_t)*(size_t)(c_num_points*rank)); + c_buf = (hsize_t*)HDmalloc(sizeof(hsize_t)*(size_t)(c_num_points*(hsize_t)rank)); if (!c_buf) return ret_value; ret_value = H5Sget_select_elem_pointlist(c_space_id, c_startpoint, c_num_points, c_buf); @@ -434,7 +434,7 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, /* and add 1 to account for array's starting at one in Fortran */ i2 = 0; for( i = 0; i < c_num_points; i++) { - i1 = rank*(i+1); + i1 = (hsize_t)rank*(i+1); for(j = 0; j < rank; j++) { buf[i2] = (hsize_t_f)(c_buf[i1-1]+1); i2 = i2 + 1; @@ -442,10 +442,6 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, } } -/* for( i = 0; i < c_num_points*rank; i++) { */ -/* printf("%i \n", (int)c_buf[i]+1); */ -/* } */ - if (ret_value >= 0 ) ret_value = 0; HDfree(c_buf); @@ -453,8 +449,6 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, return ret_value; } - - /****if* H5Sf/h5sselect_all_c * NAME * h5sselect_all_c @@ -1230,7 +1224,8 @@ nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hsi H5S_seloper_t c_op; herr_t status; int rank; - int i, j; + size_t i; + int j; hsize_t *c_coord; size_t c_nelements; @@ -1239,11 +1234,11 @@ nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hsi c_space_id = *space_id; rank = H5Sget_simple_extent_ndims(c_space_id); - c_coord = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank*(*nelements)); + c_coord = (hsize_t *)HDmalloc(sizeof(hsize_t)*(size_t)rank*((size_t)*nelements)); if(!c_coord) return ret_value; - for (i=0; i< *nelements; i++) { + for (i=0; i< (size_t)*nelements; i++) { for (j = 0; j < rank; j++) { - c_coord[j+i*rank] = (hsize_t)coord[j + i*rank]; + c_coord[(size_t)j+i*(size_t)rank] = (hsize_t)coord[(size_t)j + i*(size_t)rank]; } } diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index 878119f..7e1aa42 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -26,9 +26,9 @@ /****if* H5Tf/h5topen_c * NAME - * h5topen_c + * h5topen_c * PURPOSE - * Call H5Topen2 to open a datatype + * Call H5Topen2 to open a datatype * INPUTS * loc_id - file or group identifier * name - name of the datatype within file or group @@ -78,9 +78,9 @@ done: /****if* H5Tf/h5tcommit_c * NAME - * h5tcommit_c + * h5tcommit_c * PURPOSE - * Call H5Tcommit2 to commit a datatype + * Call H5Tcommit2 to commit a datatype * INPUTS * loc_id - file or group identifier * name - name of the datatype within file or group @@ -126,9 +126,9 @@ done: /****if* H5Tf/h5tclose_c * NAME - * h5tclose_c + * h5tclose_c * PURPOSE - * Call H5Tclose to close the datatype + * Call H5Tclose to close the datatype * INPUTS * type_id - identifier of the datatype to be closed * RETURNS @@ -156,9 +156,9 @@ nh5tclose_c ( hid_t_f *type_id ) /****if* H5Tf/h5tcopy_c * NAME - * h5tcopy_c + * h5tcopy_c * PURPOSE - * Call H5Tcopy to copy a datatype + * Call H5Tcopy to copy a datatype * INPUTS * type_id - identifier of the datatype to be copied * OUTPUTS @@ -190,9 +190,9 @@ nh5tcopy_c ( hid_t_f *type_id , hid_t_f *new_type_id) /****if* H5Tf/h5tequal_c * NAME - * h5tequal_c + * h5tequal_c * PURPOSE - * Call H5Tequal to copy a datatype + * Call H5Tequal to copy a datatype * INPUTS * type1_id - datatype identifier * type2_id - datatype identifier @@ -289,9 +289,9 @@ nh5tget_class_c ( hid_t_f *type_id , int_f *classtype) /****if* H5Tf/h5tget_order_c * NAME - * h5tget_order_c + * h5tget_order_c * PURPOSE - * Call H5Tget_order to determine byte order + * Call H5Tget_order to determine byte order * INPUTS * type_id - identifier of the dataspace * OUTPUTS @@ -333,9 +333,9 @@ nh5tget_order_c ( hid_t_f *type_id , int_f *order) /****if* H5Tf/h5tset_order_c * NAME - * h5tset_order_c + * h5tset_order_c * PURPOSE - * Call H5Tset_order to set byte order + * Call H5Tset_order to set byte order * INPUTS * type_id - identifier of the dataspace * order; possible values are: @@ -374,9 +374,9 @@ nh5tset_order_c ( hid_t_f *type_id , int_f *order) /****if* H5Tf/h5tget_size_c * NAME - * h5tget_size_c + * h5tget_size_c * PURPOSE - * Call H5Tget_size to get size of the datatype + * Call H5Tget_size to get size of the datatype * INPUTS * type_id - identifier of the dataspace * OUTPUTS @@ -409,9 +409,9 @@ nh5tget_size_c ( hid_t_f *type_id , size_t_f *size) /****if* H5Tf/h5tset_size_c * NAME - * h5tset_size_c + * h5tset_size_c * PURPOSE - * Call H5Tget_size to get size of the datatype + * Call H5Tget_size to get size of the datatype * INPUTS * type_id - identifier of the dataspace * OUTPUTS @@ -445,9 +445,9 @@ nh5tset_size_c ( hid_t_f *type_id , size_t_f *size) /****if* H5Tf/h5tget_precision_c * NAME - * h5tget_precision_c + * h5tget_precision_c * PURPOSE - * Call H5Tget_precision to get precision of the datatype + * Call H5Tget_precision to get precision of the datatype * INPUTS * type_id - identifier of the dataspace * OUTPUTS @@ -480,9 +480,9 @@ nh5tget_precision_c ( hid_t_f *type_id , size_t_f *precision) /****if* H5Tf/h5tset_precision_c * NAME - * h5tset_precision_c + * h5tset_precision_c * PURPOSE - * Call H5Tset_precision to set precision of the datatype + * Call H5Tset_precision to set precision of the datatype * INPUTS * type_id - identifier of the dataspace * precision - number of significant bits @@ -515,9 +515,9 @@ nh5tset_precision_c ( hid_t_f *type_id , size_t_f *precision) /****if* H5Tf/h5tget_offset_c * NAME - * h5tget_offset_c + * h5tget_offset_c * PURPOSE - * Call H5Tget_offset to get bit offset of the first + * Call H5Tget_offset to get bit offset of the first * significant bit of the datatype * INPUTS * type_id - identifier of the dataspace @@ -552,9 +552,9 @@ nh5tget_offset_c ( hid_t_f *type_id , size_t_f *offset) /****if* H5Tf/h5tset_offset_c * NAME - * h5tset_offset_c + * h5tset_offset_c * PURPOSE - * Call H5Tset_offset to set bit offset of the first + * Call H5Tset_offset to set bit offset of the first * significant bit of the datatype * INPUTS * type_id - identifier of the dataspace @@ -588,9 +588,9 @@ nh5tset_offset_c ( hid_t_f *type_id , size_t_f *offset) /****if* H5Tf/h5tget_pad_c * NAME - * h5tget_pad_c + * h5tget_pad_c * PURPOSE - * Call H5Tget_pad to get the padding type of the least and + * Call H5Tget_pad to get the padding type of the least and * most-significant bit padding * * INPUTS @@ -629,11 +629,11 @@ nh5tget_pad_c ( hid_t_f *type_id , int_f * lsbpad, int_f * msbpad) /****if* H5Tf/h5tset_pad_c * NAME - * h5tset_pad_c + * h5tset_pad_c * INPUTS * type_id - identifier of the dataspace * PURPOSE - * Call H5Tset_pad to set the padding type of the least and + * Call H5Tset_pad to set the padding type of the least and * most-significant bit padding * * INPUTS @@ -670,9 +670,9 @@ nh5tset_pad_c ( hid_t_f *type_id, int_f * lsbpad, int_f* msbpad ) /****if* H5Tf/h5tget_sign_c * NAME - * h5tget_sign_c + * h5tget_sign_c * PURPOSE - * Call H5Tget_sign to get sign type for an integer type + * Call H5Tget_sign to get sign type for an integer type * INPUTS * type_id - identifier of the dataspace * OUTPUTS @@ -705,9 +705,9 @@ nh5tget_sign_c ( hid_t_f *type_id , int_f *sign) /****if* H5Tf/h5tset_sign_c * NAME - * h5tset_sign_c + * h5tset_sign_c * PURPOSE - * Call H5Tset_sign to set sign type for an integer type + * Call H5Tset_sign to set sign type for an integer type * INPUTS * type_id - identifier of the dataspace * sign - sign type for an integer typ @@ -741,9 +741,9 @@ nh5tset_sign_c ( hid_t_f *type_id , int_f* sign) /****if* H5Tf/h5tget_fields_c * NAME - * h5tget_fields_c + * h5tget_fields_c * PURPOSE - * Call H5Tget_fields to get floating point datatype + * Call H5Tget_fields to get floating point datatype * bit field information * INPUTS * type_id - identifier of the dataspace @@ -785,9 +785,9 @@ nh5tget_fields_c ( hid_t_f *type_id , size_t_f *spos, size_t_f *epos, size_t_f* /****if* H5Tf/h5tset_fields_c * NAME - * h5tset_fields_c + * h5tset_fields_c * PURPOSE - * Call H5Tset_fields to set floating point datatype + * Call H5Tset_fields to set floating point datatype * bit field information * INPUTS * type_id - identifier of the dataspace @@ -829,9 +829,9 @@ nh5tset_fields_c ( hid_t_f *type_id, size_t_f *spos, size_t_f *epos, size_t_f* e /****if* H5Tf/h5tget_ebias_c * NAME - * h5tget_ebias_c + * h5tget_ebias_c * PURPOSE - * Call H5Tget_ebias to get exponent bias of a + * Call H5Tget_ebias to get exponent bias of a * floating-point type of the datatype * INPUTS * type_id - identifier of the dataspace @@ -866,9 +866,9 @@ nh5tget_ebias_c ( hid_t_f *type_id , size_t_f *ebias) /****if* H5Tf/h5tset_ebias_c * NAME - * h5tset_ebias_c + * h5tset_ebias_c * PURPOSE - * Call H5Tset_ebias to set exponent bias of a + * Call H5Tset_ebias to set exponent bias of a * floating-point type of the datatype * INPUTS * type_id - identifier of the dataspace @@ -903,9 +903,9 @@ nh5tset_ebias_c ( hid_t_f *type_id , size_t_f *ebias) /****if* H5Tf/h5tget_norm_c * NAME - * h5tget_norm_c + * h5tget_norm_c * PURPOSE - * Call H5Tget_norm to get mantissa normalization + * Call H5Tget_norm to get mantissa normalization * of a floating-point datatype * INPUTS * type_id - identifier of the dataspace @@ -940,9 +940,9 @@ nh5tget_norm_c ( hid_t_f *type_id , int_f *norm) /****if* H5Tf/h5tset_norm_c * NAME - * h5tset_norm_c + * h5tset_norm_c * PURPOSE - * Call H5Tset_norm to set mantissa normalization of + * Call H5Tset_norm to set mantissa normalization of * floating-point type of the datatype * INPUTS * type_id - identifier of the dataspace @@ -977,9 +977,9 @@ nh5tset_norm_c ( hid_t_f *type_id , int_f *norm) /****if* H5Tf/h5tget_inpad_c * NAME - * h5tget_inpad_c + * h5tget_inpad_c * PURPOSE - * Call H5Tget_inpad to get the padding type for + * Call H5Tget_inpad to get the padding type for * unused bits in floating-point datatypes * * INPUTS @@ -1016,11 +1016,11 @@ nh5tget_inpad_c ( hid_t_f *type_id , int_f * padtype) /****if* H5Tf/h5tset_inpad_c * NAME - * h5tset_inpad_c + * h5tset_inpad_c * INPUTS * type_id - identifier of the dataspace * PURPOSE - * Call H5Tset_inpad to set the padding type + * Call H5Tset_inpad to set the padding type * unused bits in floating-point datatype * * INPUTS @@ -1057,9 +1057,9 @@ nh5tset_inpad_c ( hid_t_f *type_id, int_f * padtype) /****if* H5Tf/h5tget_cset_c * NAME - * h5tget_cset_c + * h5tget_cset_c * PURPOSE - * Call H5Tget_cset to get character set + * Call H5Tget_cset to get character set * type of a string datatype * * INPUTS @@ -1095,11 +1095,11 @@ nh5tget_cset_c ( hid_t_f *type_id , int_f * cset) /****if* H5Tf/h5tset_cset_c * NAME - * h5tset_cset_c + * h5tset_cset_c * INPUTS * type_id - identifier of the dataspace * PURPOSE - * Call H5Tset_cset to set character set + * Call H5Tset_cset to set character set * type of a string datatype * * INPUTS @@ -1135,9 +1135,9 @@ nh5tset_cset_c ( hid_t_f *type_id, int_f * cset) /****if* H5Tf/h5tget_strpad_c * NAME - * h5tget_strpad_c + * h5tget_strpad_c * PURPOSE - * Call H5Tget_strpad to get string padding method + * Call H5Tget_strpad to get string padding method * for a string datatype * INPUTS * type_id - identifier of the dataspace @@ -1171,11 +1171,11 @@ nh5tget_strpad_c ( hid_t_f *type_id , int_f * strpad) /****if* H5Tf/h5tset_strpad_c * NAME - * h5tset_strpad_c + * h5tset_strpad_c * INPUTS * type_id - identifier of the dataspace * PURPOSE - * Call H5Tset_strpad to set string padding method + * Call H5Tset_strpad to set string padding method * for a string datatype * * INPUTS @@ -1211,9 +1211,9 @@ nh5tset_strpad_c ( hid_t_f *type_id, int_f * strpad) /****if* H5Tf/h5tget_nmembers_c * NAME - * h5tget_nmembers_c + * h5tget_nmembers_c * PURPOSE - * Call H5Tget_nmembers to get number of fields + * Call H5Tget_nmembers to get number of fields * in a compound datatype * INPUTS * type_id - identifier of the dataspace @@ -1246,9 +1246,9 @@ nh5tget_nmembers_c ( hid_t_f *type_id , int_f * num_members) /****if* H5Tf/h5tget_member_name_c * NAME - * h5tget_member_name_c + * h5tget_member_name_c * PURPOSE - * Call H5Tget_member_name to get name + * Call H5Tget_member_name to get name * of a compound datatype * INPUTS * type_id - identifier of the dataspace @@ -1287,9 +1287,9 @@ nh5tget_member_name_c ( hid_t_f *type_id ,int_f* idx, _fcd member_name, int_f *n } /****if* H5Tf/h5tget_member_index_c * NAME - * h5tget_member_index_c + * h5tget_member_index_c * PURPOSE - * Call H5Tget_member_index to get an index of + * Call H5Tget_member_index to get an index of * the specified datatype filed or member. * INPUTS * type_id - datatype identifier @@ -1301,7 +1301,7 @@ nh5tget_member_name_c ( hid_t_f *type_id ,int_f* idx, _fcd member_name, int_f *n * 0 on success, -1 on failure * AUTHOR * Elena Pourmal - * Thursday, September 26, 2002 + * Thursday, September 26, 2002 * HISTORY * * SOURCE @@ -1312,15 +1312,13 @@ nh5tget_member_index_c (hid_t_f *type_id, _fcd name, int_f *namelen, int_f *idx) { int ret_value = -1; char *c_name; - size_t c_namelen; hid_t c_type_id; int c_index; /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; /* @@ -1340,9 +1338,9 @@ DONE: /****if* H5Tf/h5tget_member_offset_c * NAME - * h5tget_member_offset_c + * h5tget_member_offset_c * PURPOSE - * Call H5Tget_member_offset to get byte offset of the + * Call H5Tget_member_offset to get byte offset of the * beginning of a field within a compound datatype with * respect to the beginning of the compound data type datum * INPUTS @@ -1367,12 +1365,8 @@ nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f * offset) { int ret_value = -1; size_t c_offset; - hid_t c_type_id; - unsigned c_member_no; - c_type_id = *type_id; - c_member_no = *member_no; - c_offset = H5Tget_member_offset(c_type_id, c_member_no); + c_offset = H5Tget_member_offset((hid_t)*type_id, (unsigned)*member_no); *offset = (size_t_f)c_offset; ret_value = 0; return ret_value; @@ -1380,9 +1374,9 @@ nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f * offset) /****if* H5Tf/h5tget_array_dims_c * NAME - * h5tget_array_dims_c + * h5tget_array_dims_c * PURPOSE - * Call H5Tget_array_dims2 to get + * Call H5Tget_array_dims2 to get * dimensions of array datatype * INPUTS * type_id - identifier of the array datatype @@ -1423,9 +1417,9 @@ DONE: /****if* H5Tf/h5tget_array_ndims_c * NAME - * h5tget_array_ndims_c + * h5tget_array_ndims_c * PURPOSE - * Call H5Tget_array_ndims to get number + * Call H5Tget_array_ndims to get number * of dimensions of array datatype * INPUTS * type_id - identifier of the array datatype @@ -1460,9 +1454,9 @@ nh5tget_array_ndims_c ( hid_t_f *type_id , int_f * ndims) /****if* H5Tf/h5tget_super_c * NAME - * h5tget_super_c + * h5tget_super_c * PURPOSE - * Call H5Tget_super to get base datatype from which + * Call H5Tget_super to get base datatype from which * datatype was derived * INPUTS * type_id - identifier of the array datatype @@ -1498,9 +1492,9 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id) /****if* H5Tf/h5tget_member_type_c * NAME - * h5tget_member_type_c + * h5tget_member_type_c * PURPOSE - * Call H5Tget_member_type to get the identifier of a copy of + * Call H5Tget_member_type to get the identifier of a copy of * the datatype of the field * INPUTS * type_id - identifier of the datatype @@ -1511,7 +1505,7 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id) * 0 on success, -1 on failure * AUTHOR * XIANGYANG SU - * Thursday, February 3, 2000 + * Thursday, February 3, 2000 * HISTORY * * SOURCE @@ -1522,12 +1516,8 @@ nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype) /******/ { int ret_value = -1; - hid_t c_type_id; - unsigned c_field_idx; - c_type_id = *type_id; - c_field_idx = *field_idx; - *datatype = (hid_t_f)H5Tget_member_type(c_type_id, c_field_idx); + *datatype = (hid_t_f)H5Tget_member_type((hid_t)*type_id, (unsigned)*field_idx); if(*datatype < 0) return ret_value; ret_value = 0; @@ -1537,9 +1527,9 @@ nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype) /****if* H5Tf/h5tcreate_c * NAME - * h5tcreate_c + * h5tcreate_c * PURPOSE - * Call H5Tcreate to create a datatype + * Call H5Tcreate to create a datatype * INPUTS * cls - class type * size - size of the class memeber @@ -1573,20 +1563,20 @@ nh5tcreate_c(int_f *cls, size_t_f *size, hid_t_f *type_id) /****if* H5Tf/h5tinsert_c * NAME - * h5tinsert_c + * h5tinsert_c * PURPOSE - * Call H5Tinsert to adds another member to the compound datatype + * Call H5Tinsert to adds another member to the compound datatype * INPUTS - * type_id - identifier of the datatype - * name - Name of the field to insert - * namelen - length of the name - * offset - Offset in memory structure of the field to insert - * field_id - datatype identifier of the new member + * type_id - identifier of the datatype + * name - Name of the field to insert + * namelen - length of the name + * offset - Offset in memory structure of the field to insert + * field_id - datatype identifier of the new member * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * XIANGYANG SU - * Thursday, February 3, 2000 + * Thursday, February 3, 2000 * HISTORY * * SOURCE @@ -1597,21 +1587,14 @@ nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_ /******/ { int ret_value = -1; - hid_t c_type_id; - hid_t c_field_id; char* c_name; - size_t c_namelen; - size_t c_offset; herr_t error; - c_offset =(size_t) *offset; - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; - c_type_id = *type_id; - c_field_id = *field_id; - error = H5Tinsert(c_type_id, c_name, c_offset, c_field_id); + error = H5Tinsert((hid_t)*type_id, c_name, (size_t)*offset, (hid_t)*field_id); + HDfree(c_name); if(error < 0) return ret_value; ret_value = 0; @@ -1621,18 +1604,18 @@ nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_ /****if* H5Tf/h5tpack_c * NAME - * h5tpack_c + * h5tpack_c * PURPOSE - * Call H5Tpack tor ecursively remove padding from - * within a compound datatype to make it more efficient - * (space-wise) to store that data + * Call H5Tpack tor ecursively remove padding from + * within a compound datatype to make it more efficient + * (space-wise) to store that data * INPUTS - * type_id - identifier of the datatype + * type_id - identifier of the datatype * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * XIANGYANG SU - * Thursday, February 3, 2000 + * Thursday, February 3, 2000 * HISTORY * * SOURCE @@ -1656,9 +1639,9 @@ nh5tpack_c(hid_t_f * type_id) /****if* H5Tf/h5tarray_create_c * NAME - * h5tarray_create_c + * h5tarray_create_c * PURPOSE - * Call H5Tarray_create2 to create array datatype + * Call H5Tarray_create2 to create array datatype * INPUTS * base_id - identifier of array base datatype * rank - array's rank @@ -1668,7 +1651,7 @@ nh5tpack_c(hid_t_f * type_id) * 0 on success, -1 on failure * AUTHOR * Elena Pourmal - * Thursday, November 16, 2000 + * Thursday, November 16, 2000 * HISTORY * * SOURCE @@ -1687,7 +1670,7 @@ nh5tarray_create_c(hid_t_f * base_id, int_f *rank, hsize_t_f* dims, hid_t_f* typ * Transpose dimension arrays because of C-FORTRAN storage order */ for(u = 0; u < (unsigned)*rank ; u++) - c_dims[u] = (hsize_t)dims[(*rank - u) - 1]; + c_dims[u] = (hsize_t)dims[((unsigned)*rank - u) - 1]; if((c_type_id = H5Tarray_create2((hid_t)*base_id, (unsigned)*rank, c_dims)) < 0) goto DONE; @@ -1702,19 +1685,19 @@ DONE: /****if* H5Tf/h5tenum_create_c * NAME - * h5tenum_create_c + * h5tenum_create_c * PURPOSE - * Call H5Tenum_create to create a new enumeration datatype + * Call H5Tenum_create to create a new enumeration datatype * INPUTS - * parent_id - Datatype identifier for the base datatype + * parent_id - Datatype identifier for the base datatype * OUTPUTS - * new_type_id - datatype identifier for the new - * enumeration datatype + * new_type_id - datatype identifier for the new + * enumeration datatype * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * Xiangyang Su - * Tuesday, February 15, 1999 + * Tuesday, February 15, 1999 * HISTORY * * SOURCE @@ -1725,11 +1708,9 @@ nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id) /******/ { int ret_value = 0; - hid_t c_parent_id; hid_t c_new_type_id; - c_parent_id = *parent_id; - c_new_type_id = H5Tenum_create(c_parent_id); + c_new_type_id = H5Tenum_create((hid_t)*parent_id); if ( c_new_type_id < 0 ) ret_value = -1; *new_type_id = (hid_t_f)c_new_type_id; @@ -1764,12 +1745,10 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) { int ret_value = -1; char* c_name; - size_t c_namelen; herr_t error; int_f c_value; - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; c_value = *value; @@ -1785,9 +1764,9 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) /****if* H5Tf/h5tenum_nameof_c * NAME - * h5tenum_nameof_c + * h5tenum_nameof_c * PURPOSE - * Call H5Tenum_nameof to find the symbol name that corresponds to + * Call H5Tenum_nameof to find the symbol name that corresponds to * the specified value of the enumeration datatype type * INPUTS * type_id - identifier of the datatype @@ -1829,9 +1808,9 @@ nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen) /****if* H5Tf/h5tenum_valueof_c * NAME - * h5tenum_valueof_c + * h5tenum_valueof_c * PURPOSE - * Call H5Tenum_valueof to find the value of that corresponds to + * Call H5Tenum_valueof to find the value of that corresponds to * the specified name of the enumeration datatype type * INPUTS * type_id - identifier of the datatype @@ -1853,16 +1832,12 @@ nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) /******/ { int ret_value = -1; - hid_t c_type_id; char* c_name; - size_t c_namelen; herr_t error; - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; - c_type_id = *type_id; - error = H5Tenum_valueof(c_type_id, c_name, value); + error = H5Tenum_valueof((hid_t)*type_id, c_name, value); HDfree(c_name); if(error < 0) return ret_value; @@ -1873,9 +1848,9 @@ nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) /****if* H5Tf/h5tget_member_value_c * NAME - * h5tget_member_value_c + * h5tget_member_value_c * PURPOSE - * Call H5Tget_member_value to get the value of an + * Call H5Tget_member_value to get the value of an * enumeration datatype member * INPUTS * type_id - identifier of the datatype @@ -1896,14 +1871,10 @@ nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value) /******/ { int ret_value = -1; - hid_t c_type_id; - unsigned c_member_no; int c_value; herr_t error; - c_type_id = *type_id; - c_member_no = *member_no; - error = H5Tget_member_value(c_type_id, c_member_no, &c_value); + error = H5Tget_member_value((hid_t)*type_id, (unsigned)*member_no, &c_value); if(error < 0) return ret_value; *value = (int_f)c_value; @@ -1913,11 +1884,11 @@ nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value) /****if* H5Tf/h5tset_tag_c * NAME - * h5tset_tag_c + * h5tset_tag_c * INPUTS * type_id - identifier of the dataspace * PURPOSE - * Call H5Tset_tag to set an opaque datatype tag + * Call H5Tset_tag to set an opaque datatype tag * INPUTS * type_id - identifier of the dataspace * tag - Unique ASCII string with which the opaque @@ -1937,16 +1908,12 @@ nh5tset_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen) /******/ { int ret_value = -1; - hid_t c_type_id; herr_t status; char* c_tag; - size_t c_namelen; - c_namelen = *namelen; - c_tag = (char *)HD5f2cstring(tag, c_namelen); + c_tag = (char *)HD5f2cstring(tag, (size_t)*namelen); - c_type_id = *type_id; - status = H5Tset_tag(c_type_id, c_tag); + status = H5Tset_tag((hid_t)*type_id, c_tag); HDfree(c_tag); if ( status < 0 ) return ret_value; @@ -1956,7 +1923,7 @@ nh5tset_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen) /****if* H5Tf/h5tget_tag_c * NAME - * h5tget_tag_c + * h5tget_tag_c * PURPOSE * Call H5Tset_tag to set an opaque datatype tag * INPUTS @@ -1994,9 +1961,9 @@ nh5tget_tag_c(hid_t_f* type_id, _fcd tag, size_t_f* tag_size, int_f* taglen) } /****if* H5Tf/h5tvlen_create_c * NAME - * h5tvlen_create_c + * h5tvlen_create_c * PURPOSE - * Call H5Tvlen_create to create VL dtatype + * Call H5Tvlen_create to create VL dtatype * INPUTS * type_id - identifier of the base datatype * OUTPUTS @@ -2027,9 +1994,9 @@ nh5tvlen_create_c(hid_t_f* type_id, hid_t_f *vltype_id) } /****if* H5Tf/h5tis_variable_str_c * NAME - * h5tis_variable_str_c + * h5tis_variable_str_c * PURPOSE - * Call H5Tis_variable_str to detrmine if the datatype + * Call H5Tis_variable_str to detrmine if the datatype * is a variable string. * INPUTS * type_id - identifier of the dataspace @@ -2062,9 +2029,9 @@ nh5tis_variable_str_c ( hid_t_f *type_id , int_f *flag ) } /****if* H5Tf/h5tget_member_class_c * NAME - * h5tget_member_class_c + * h5tget_member_class_c * PURPOSE - * Call H5Tget_member_class to detrmine ithe class of the compound + * Call H5Tget_member_class to detrmine ithe class of the compound * datatype member * INPUTS * type_id - identifier of the dataspace @@ -2102,9 +2069,9 @@ nh5tget_member_class_c ( hid_t_f *type_id , int_f *member_no, int_f *cls ) /****if* H5Tf/h5tcommit_anon_c * NAME - * h5tcommit_anon_c + * h5tcommit_anon_c * PURPOSE - * Call H5Tcommit_anon + * Call H5Tcommit_anon * INPUTS * loc_id - file or group identifier * dtype_id - dataset identifier @@ -2138,9 +2105,9 @@ nh5tcommit_anon_c(hid_t_f *loc_id, hid_t_f *dtype_id, /****if* H5Tf/h5tcommitted_c * NAME - * h5tcommitted_c + * h5tcommitted_c * PURPOSE - * Call H5Tcommitted + * Call H5Tcommitted * dtype_id - dataset identifier * RETURNS * a positive value, for TRUE, if the datatype has been committed, @@ -2169,9 +2136,9 @@ nh5tcommitted_c(hid_t_f *dtype_id) /****if* H5Tf/h5tdecode_c * NAME - * h5tdecode_c + * h5tdecode_c * PURPOSE - * Call H5Tdecode + * Call H5Tdecode * INPUTS * * buf - Buffer for the data space object to be decoded. @@ -2215,9 +2182,9 @@ nh5tdecode_c ( _fcd buf, hid_t_f *obj_id ) /****if* H5Tf/h5tencode_c * NAME - * h5tencode_c + * h5tencode_c * PURPOSE - * Call H5Tencode + * Call H5Tencode * INPUTS * * obj_id - Identifier of the object to be encoded. @@ -2285,9 +2252,9 @@ nh5tencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) /****if* H5Tf/h5tget_create_plist_c * NAME - * h5tget_create_plist_c + * h5tget_create_plist_c * PURPOSE - * Call H5Tget_create_plist + * Call H5Tget_create_plist * INPUTS * dtype_id - Datatype identifier * OUTPUTS @@ -2317,9 +2284,9 @@ nh5tget_create_plist_c ( hid_t_f *dtype_id, hid_t_f *dtpl_id) /****if* H5Tf/h5tcompiler_conv_c * NAME - * h5tcompiler_conv_c + * h5tcompiler_conv_c * PURPOSE - * Call H5Tcompiler_conv + * Call H5Tcompiler_conv * INPUTS * * src_id - Identifier for the source datatype. @@ -2351,9 +2318,9 @@ nh5tcompiler_conv_c ( hid_t_f *src_id, hid_t_f *dst_id, int_f *c_flag) } /****if* H5Tf/h5tget_native_type_c * NAME - * h5tget_native_type_c + * h5tget_native_type_c * PURPOSE - * Call H5Tget_native_type + * Call H5Tget_native_type * INPUTS * * dtype_id - Datatype identifier for the dataset datatype. @@ -2449,13 +2416,11 @@ h5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value) int ret_value = -1; hid_t status; char *c_name; - size_t c_namelen; /* * Convert FORTRAN name to C name */ - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, c_namelen); + c_name = (char *)HD5f2cstring(name, (size_t)*namelen); if (c_name == NULL) return ret_value; status = H5Tenum_insert( (hid_t)*type_id, c_name, value); diff --git a/fortran/src/H5Zf.c b/fortran/src/H5Zf.c index 0427c23..169e018 100644 --- a/fortran/src/H5Zf.c +++ b/fortran/src/H5Zf.c @@ -51,9 +51,7 @@ nh5zunregister_c (int_f *filter) * Call H5Zunregister function. */ c_filter = (H5Z_filter_t)*filter; - printf(" filter # %d \n", (int)c_filter); status = H5Zunregister(c_filter); - printf("From C zunregister %d \n", status); if (status < 0) return ret_value; ret_value = 0; return ret_value; diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index a149109..1641989 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -421,12 +421,17 @@ nh5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, /* * H5F flags + * + * Note that H5F_ACC_DEBUG is deprecated (nonfunctional) but retained + * for backward compatibility since it's in the public API. */ h5f_flags[0] = (int_f)H5F_ACC_RDWR; h5f_flags[1] = (int_f)H5F_ACC_RDONLY; h5f_flags[2] = (int_f)H5F_ACC_TRUNC; h5f_flags[3] = (int_f)H5F_ACC_EXCL; +#ifndef H5_NO_DEPRECATED_SYMBOLS h5f_flags[4] = (int_f)H5F_ACC_DEBUG; +#endif /* H5_NO_DEPRECATED_SYMBOLS */ h5f_flags[5] = (int_f)H5F_SCOPE_LOCAL; h5f_flags[6] = (int_f)H5F_SCOPE_GLOBAL; h5f_flags[7] = (int_f)H5F_CLOSE_DEFAULT; diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 index ca50e20..0e371f5 100644 --- a/fortran/src/H5f90global.f90 +++ b/fortran/src/H5f90global.f90 @@ -234,6 +234,9 @@ MODULE H5GLOBAL ! ! H5F flags (DO NOT FORGET TO UPDATE WHEN NEW FLAGS ARE ADDED !) ! + ! NOTE: H5F_ACC_DEBUG is deprecated (nonfunctional) but retained for + ! backward compatibility since it's in the public API. + ! ! H5F flags declaration ! INTEGER, PARAMETER :: H5F_FLAGS_LEN = 19 diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index b5e40a8..6bde877 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -995,7 +995,7 @@ H5_FCDLL int_f nh5pcreate_c ( hid_t_f *cls, hid_t_f *prp_id ); H5_FCDLL int_f nh5pclose_c ( hid_t_f *prp_id ); H5_FCDLL int_f nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id); H5_FCDLL int_f nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f *c_flag); -H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype); +H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , hid_t_f *classtype); H5_FCDLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level); H5_FCDLL int_f nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims ); H5_FCDLL int_f nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims ); diff --git a/fortran/src/README b/fortran/src/README index c877050..7af5df3 100644 --- a/fortran/src/README +++ b/fortran/src/README @@ -88,7 +88,6 @@ Compilation grpdsetexample - creates datasets in the groups hyperslabexample - writes and reads a hyperslab selectele - writes element selections - grpit - iterates through the members of the group attrexample - creates and writes a dataset attribute compound - creates, writes and reads one dim array of structures mountexample - shows how to use mounting files to access a dataset diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 3395906..2893156 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -4,14 +4,14 @@ PROJECT (HDF5_FORTRAN_TESTS C CXX Fortran) #----------------------------------------------------------------------------- # Setup include Directories #----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${CMAKE_Fortran_MODULE_DIRECTORY} ${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) +INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) #----------------------------------------------------------------------------- # Add Test Lib #----------------------------------------------------------------------------- add_library (${HDF5_F90_C_TEST_LIB_TARGET} ${LIB_TYPE} t.c) set_source_files_properties (t.c PROPERTIES LANGUAGE C) -TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIB_TARGET} " " " ") +TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIB_TARGET} ${LIB_TYPE} " " " ") target_link_libraries (${HDF5_F90_C_TEST_LIB_TARGET} ${HDF5_F90_C_LIB_TARGET} ${HDF5_TEST_LIB_TARGET} @@ -46,8 +46,7 @@ if (WIN32) endif (BUILD_SHARED_LIBS) set_property (TARGET ${HDF5_F90_TEST_LIB_TARGET} APPEND PROPERTY COMPILE_DEFINITIONS HDF5F90_WINDOWS) endif (WIN32) -TARGET_FORTRAN_PROPERTIES (${HDF5_F90_TEST_LIB_TARGET} " " ${SHARED_LINK_FLAGS}) -set_target_properties (${HDF5_F90_TEST_LIB_TARGET} PROPERTIES LINKER_LANGUAGE Fortran) +TARGET_FORTRAN_PROPERTIES (${HDF5_F90_TEST_LIB_TARGET} ${LIB_TYPE} " " ${SHARED_LINK_FLAGS}) target_link_libraries (${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_C_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -58,6 +57,7 @@ set_target_properties (${HDF5_F90_TEST_LIB_TARGET} PROPERTIES FOLDER libraries/test/fortran LINKER_LANGUAGE Fortran INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} ) #----------------------------------------------------------------------------- @@ -83,7 +83,7 @@ add_executable (testhdf5_fortran tHDF5.f90 ) TARGET_NAMING (testhdf5_fortran ${LIB_TYPE}) -TARGET_FORTRAN_PROPERTIES (testhdf5_fortran " " " ") +TARGET_FORTRAN_PROPERTIES (testhdf5_fortran ${LIB_TYPE} " " " ") target_link_libraries (testhdf5_fortran ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -92,8 +92,12 @@ target_link_libraries (testhdf5_fortran if (WIN32 AND MSVC) target_link_libraries (testhdf5_fortran "ws2_32.lib") endif (WIN32 AND MSVC) -set_target_properties (testhdf5_fortran PROPERTIES LINKER_LANGUAGE Fortran) -set_target_properties (testhdf5_fortran PROPERTIES FOLDER test/fortran) +target_include_directories (testhdf5_fortran PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +set_target_properties (testhdf5_fortran PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} +) #-- Adding test for testhdf5_fortran_1_8 add_executable (testhdf5_fortran_1_8 @@ -105,7 +109,7 @@ add_executable (testhdf5_fortran_1_8 tHDF5_1_8.f90 ) TARGET_NAMING (testhdf5_fortran_1_8 ${LIB_TYPE}) -TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8 " " " ") +TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8 ${LIB_TYPE} " " " ") target_link_libraries (testhdf5_fortran_1_8 ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -114,8 +118,12 @@ target_link_libraries (testhdf5_fortran_1_8 if (WIN32 AND MSVC) target_link_libraries (testhdf5_fortran_1_8 "ws2_32.lib") endif (WIN32 AND MSVC) -set_target_properties (testhdf5_fortran_1_8 PROPERTIES LINKER_LANGUAGE Fortran) -set_target_properties (testhdf5_fortran_1_8 PROPERTIES FOLDER test/fortran) +target_include_directories (testhdf5_fortran_1_8 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +set_target_properties (testhdf5_fortran_1_8 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} +) #-- Adding test for fortranlib_test_F03 if (HDF5_ENABLE_F2003) @@ -130,7 +138,7 @@ if (HDF5_ENABLE_F2003) tHDF5_F03.f90 ) TARGET_NAMING (fortranlib_test_F03 ${LIB_TYPE}) - TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 " " " ") + TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 ${LIB_TYPE} " " " ") target_link_libraries (fortranlib_test_F03 ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -139,14 +147,18 @@ if (HDF5_ENABLE_F2003) if (WIN32 AND MSVC) target_link_libraries (fortranlib_test_F03 "ws2_32.lib") endif (WIN32 AND MSVC) - set_target_properties (fortranlib_test_F03 PROPERTIES LINKER_LANGUAGE Fortran) - set_target_properties (fortranlib_test_F03 PROPERTIES FOLDER test/fortran) + target_include_directories (fortranlib_test_F03 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + set_target_properties (fortranlib_test_F03 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} + ) endif (HDF5_ENABLE_F2003) #-- Adding test for fflush1 add_executable (fflush1 fflush1.f90) TARGET_NAMING (fflush1 ${LIB_TYPE}) -TARGET_FORTRAN_PROPERTIES (fflush1 " " " ") +TARGET_FORTRAN_PROPERTIES (fflush1 ${LIB_TYPE} " " " ") target_link_libraries (fflush1 ${HDF5_F90_LIB_TARGET} ${HDF5_F90_TEST_LIB_TARGET} @@ -155,13 +167,17 @@ target_link_libraries (fflush1 if (WIN32 AND MSVC) target_link_libraries (fflush1 "ws2_32.lib") endif (WIN32 AND MSVC) -set_target_properties (fflush1 PROPERTIES LINKER_LANGUAGE Fortran) -set_target_properties (fflush1 PROPERTIES FOLDER test/fortran) +target_include_directories (fflush1 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +set_target_properties (fflush1 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} +) #-- Adding test for fflush2 add_executable (fflush2 fflush2.f90) TARGET_NAMING (fflush2 ${LIB_TYPE}) -TARGET_FORTRAN_PROPERTIES (fflush2 " " " ") +TARGET_FORTRAN_PROPERTIES (fflush2 ${LIB_TYPE} " " " ") target_link_libraries (fflush2 ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -170,7 +186,11 @@ target_link_libraries (fflush2 if (WIN32 AND MSVC) target_link_libraries (fflush2 "ws2_32.lib") endif (WIN32 AND MSVC) -set_target_properties (fflush2 PROPERTIES LINKER_LANGUAGE Fortran) -set_target_properties (fflush2 PROPERTIES FOLDER test/fortran) +target_include_directories (fflush2 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +set_target_properties (fflush2 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} +) include (CMakeTests.cmake) diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index 039dc6c..320d661 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -89,7 +89,7 @@ PROGRAM fortranlibtest total_error) ret_total_error = 0 - CALL test_h5s_encode(cleanup, ret_total_error) + CALL test_h5s_encode(ret_total_error) CALL write_test_status(ret_total_error, & ' Testing dataspace encoding and decoding', & total_error) @@ -100,6 +100,12 @@ PROGRAM fortranlibtest ' Testing scaleoffset filter', & total_error) + ret_total_error = 0 + CALL test_genprop_basic_class(ret_total_error ) + CALL write_test_status(ret_total_error, & + ' Testing basic generic property list class creation functionality', & + total_error) + WRITE(*,*) WRITE(*,*) ' ============================================ ' diff --git a/fortran/test/t.h b/fortran/test/t.h index d315bda..6d6af52 100644 --- a/fortran/test/t.h +++ b/fortran/test/t.h @@ -34,7 +34,7 @@ H5_FCTESTDLL int_f nh5_fixname_c H5_FCTESTDLL int_f nh5_cleanup_c (_fcd base_name, size_t_f *base_namelen, hid_t_f *fapl); -H5_FCTESTDLL void nh5_exit_c +H5_FCTESTDLL NORETURN void nh5_exit_c (int_f *status); H5_FCTESTDLL void nh5_env_nocleanup_c diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index 07ca6da..e3b3b2a 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -129,8 +129,6 @@ CONTAINS !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in - LOGICAL :: differ - ! !Initialize data_in buffer diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90 index 02bef53..8e20100 100644 --- a/fortran/test/tH5A_1_8.f90 +++ b/fortran/test/tH5A_1_8.f90 @@ -157,7 +157,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) ' - Testing creating attributes by name', & total_error) - ! /* More complex tests with both "new format" and "shared" attributes */ + ! More complex tests with both "new format" and "shared" attributes IF( use_shared(j) ) THEN ret_total_error = 0 CALL test_attr_shared_rename(my_fcpl, my_fapl, ret_total_error) @@ -190,12 +190,12 @@ END SUBROUTINE attribute_test_1_8 SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_corder_create_compact(): Test basic H5A (attribute) code. !** Tests compact attribute storage on objects with attribute creation order info !** -!****************************************************************/ +!*************************************************************** ! Needed for get_info_by_name @@ -245,17 +245,17 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) data_dims = 0 ! WRITE(*,*) " - Testing Compact Storage of Attributes with Creation Order Info" - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error) CALL check("H5Pset_attr_creation_order",error,total_error) - ! /* Query the attribute creation properties */ + ! Query the attribute creation properties CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) @@ -281,7 +281,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) my_dataset = dset3 END SELECT DO u = 0, max_compact - 1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -298,7 +298,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) END DO END DO - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dset1, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset2, error) @@ -306,15 +306,15 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) @@ -341,34 +341,34 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) DO u = 0,max_compact-1 WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - ! /* Retrieve information for attribute */ + ! Retrieve information for attribute CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, & f_corder_valid, corder, cset, data_size, error, lapl_id = H5P_DEFAULT_F ) !with optional CALL check("H5Aget_info_by_name_f", error, total_error) - ! /* Verify creation order of attribute */ + ! Verify creation order of attribute CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) CALL verify("H5Aget_info_by_name_f", corder, u, total_error) - ! /* Retrieve information for attribute */ + ! Retrieve information for attribute CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, & f_corder_valid, corder, cset, data_size, error) ! without optional CALL check("H5Aget_info_by_name_f", error, total_error) - ! /* Verify creation order of attribute */ + ! Verify creation order of attribute CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) CALL verify("H5Aget_info_by_name_f", corder, u, total_error) END DO END DO - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dset1, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset2, error) @@ -376,19 +376,19 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) END SUBROUTINE test_attr_corder_create_compact SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_null_space(): Test basic H5A (attribute) code. !** Tests storing attribute with "null" dataspace !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -426,41 +426,41 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) data_dims = 0 - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Re-open file */ + ! Re-open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error) CALL check("h5open_f",error,total_error) - ! /* Create dataspace for dataset attributes */ + ! Create dataspace for dataset attributes CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create "null" dataspace for attribute */ + ! Create "null" dataspace for attribute CALL h5screate_f(H5S_NULL_F, null_sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error) CALL check("h5dcreate_f",error,total_error) - ! /* Add attribute with 'null' dataspace */ + ! Add attribute with 'null' dataspace - ! /* Create attribute */ + ! Create attribute CALL h5acreate_f(dataset, "null attr", H5T_NATIVE_INTEGER, null_sid, attr, error) CALL check("h5acreate_f",error,total_error) - ! /* Try to read data from the attribute */ - ! /* (shouldn't fail, but should leave buffer alone) */ + ! Try to read data from the attribute + ! (shouldn't fail, but should leave buffer alone) value(1) = 103 data_dims(1) = 1 CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error) CALL check("h5aread_f",error,total_error) CALL verify("h5aread_f",value(1),103,total_error) -! /* Try to read data from the attribute again but*/ -! /* for a scalar */ +! Try to read data from the attribute again but +! for a scalar value_scalar = 104 data_dims(1) = 1 @@ -482,7 +482,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) CALL h5aget_info_f(attr, f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_f", error, total_error) - ! /* Check the attribute's information */ + ! Check the attribute's information CALL VERIFY("h5aget_info_f.corder",corder,0,total_error) CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error) @@ -513,12 +513,12 @@ END SUBROUTINE test_attr_null_space SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_create_by_name(): Test basic H5A (attribute) code. !** Tests creating attributes by name !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -563,32 +563,32 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) data_dims = 0 - ! /* Create dataspace for dataset & attributes */ + ! Create dataspace for dataset & attributes CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Query the attribute creation properties */ + ! Query the attribute creation properties CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - ! /* Loop over using index for creation order value */ + ! Loop over using index for creation order value DO i = 1, 2 - ! /* Print appropriate test message */ + ! Print appropriate test message IF(use_index(i))THEN WRITE(*,*) " - Testing Creating Attributes By Name w/Creation Order Index" ELSE WRITE(*,*) " - Testing Creating Attributes By Name w/o Creation Order Index" ENDIF - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Set attribute creation order tracking & indexing for object */ + ! Set attribute creation order tracking & indexing for object IF(new_format)THEN IF(use_index(i))THEN @@ -602,7 +602,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) ENDIF - ! /* Create datasets */ + ! Create datasets CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl ) CALL check("h5dcreate_f2",error,total_error) @@ -614,7 +614,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) CALL check("h5dcreate_f4",error,total_error) - ! /* Work on all the datasets */ + ! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) @@ -632,39 +632,39 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) END SELECT - !/* Create attributes, up to limit of compact form */ + ! Create attributes, up to limit of compact form DO u = 0, max_compact - 1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 CALL H5Acreate_by_name_f(fid, dsetname, attrname, H5T_NATIVE_INTEGER, sid, & attr, error, lapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) CALL check("H5Acreate_by_name_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Verify information for NEW attribute */ + ! Verify information for NEW attribute CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error) ! CALL check("FAILED IN attr_info_by_idx_check",total_error) ENDDO - ! /* Test opening attributes stored compactly */ + ! Test opening attributes stored compactly CALL attr_open_check(fid, dsetname, my_dataset, u, total_error) ENDDO - ! /* Work on all the datasets */ + ! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) CASE (0) @@ -678,7 +678,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) dsetname = DSET3_NAME END SELECT - ! /* Create more attributes, to push into dense form */ + ! Create more attributes, to push into dense form DO u = max_compact, max_compact* 2 - 1 WRITE(chr2,'(I2.2)') u @@ -688,12 +688,12 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) attr, error, lapl_id=H5P_DEFAULT_F) CALL check("H5Acreate_by_name",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) @@ -701,7 +701,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) ENDDO - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dset1, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset2, error) @@ -710,16 +710,16 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) ENDDO - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) @@ -728,12 +728,12 @@ END SUBROUTINE test_attr_create_by_name SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_info_by_idx(): Test basic H5A (attribute) code. !** Tests querying attribute info by index !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -790,31 +790,31 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) data_dims = 0 - ! /* Create dataspace for dataset & attributes */ + ! Create dataspace for dataset & attributes CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Query the attribute creation properties */ + ! Query the attribute creation properties CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - ! /* Loop over using index for creation order value */ + ! Loop over using index for creation order value DO i = 1, 2 - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Set attribute creation order tracking & indexing for object */ + ! Set attribute creation order tracking & indexing for object IF(new_format)THEN IF(use_index(i))THEN Input1 = H5P_CRT_ORDER_INDEXED_F @@ -825,7 +825,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL check("H5Pset_attr_creation_order",error,total_error) ENDIF - ! /* Create datasets */ + ! Create datasets CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error ) CALL check("h5dcreate_f",error,total_error) @@ -836,7 +836,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error ) CALL check("h5dcreate_f",error,total_error) - ! /* Work on all the datasets */ + ! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 @@ -849,7 +849,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) my_dataset = dset3 END SELECT - ! /* Check for query on non-existant attribute */ + ! Check for query on non-existant attribute n = 0 @@ -879,10 +879,10 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL VERIFY("h5aget_name_by_idx_f",error,minusone,total_error) - ! /* Create attributes, up to limit of compact form */ + ! Create attributes, up to limit of compact form DO j = 0, max_compact-1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') j attrname = 'attr '//chr2 @@ -890,19 +890,19 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = j data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Verify information for new attribute */ + ! Verify information for new attribute !EP CALL attr_info_by_idx_check(my_dataset, attrname, INT(j,HSIZE_T), use_index(i), total_error ) htmp = j @@ -914,7 +914,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) ENDDO - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dset1, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset2, error) @@ -922,17 +922,17 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) END DO - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl,error) CALL check("h5pclose_f", error, total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) @@ -962,13 +962,13 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T - ! /* Verify the information for first attribute, in increasing creation order */ + ! Verify the information for first attribute, in increasing creation order CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, & f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) CALL verify("h5aget_info_by_idx_f",corder,0,total_error) - ! /* Verify the information for new attribute, in increasing creation order */ + ! Verify the information for new attribute, in increasing creation order CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, n, & f_corder_valid, corder, cset, data_size, error) @@ -976,7 +976,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) CALL check("h5aget_info_by_idx_f",error,total_error) CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) - ! /* Verify the name for new link, in increasing creation order */ + ! Verify the name for new link, in increasing creation order ! Try with the correct buffer size @@ -990,24 +990,24 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) ENDIF CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) - ! /* Don't test "native" order if there is no creation order index, since + ! Don't test "native" order if there is no creation order index, since ! * there's not a good way to easily predict the attribute's order in the name ! * index. - ! */ + ! IF (use_index) THEN - ! /* Verify the information for first attribute, in native creation order */ + ! Verify the information for first attribute, in native creation order CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, hzero, & f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) - ! /* Verify the information for new attribute, in native creation order */ + ! Verify the information for new attribute, in native creation order CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, & f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) - ! /* Verify the name for new link, in increasing native order */ + ! Verify the name for new link, in increasing native order CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, & n, tmpname, error) ! check with no optional parameters CALL check("h5aget_name_by_idx_f",error,total_error) @@ -1075,12 +1075,12 @@ END SUBROUTINE attr_info_by_idx_check SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_shared_rename(): Test basic H5A (attribute) code. !** Tests renaming shared attributes in "compact" & "dense" storage !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -1128,114 +1128,114 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank - ! /* Initialize "big" attribute data */ + ! Initialize "big" attribute data - ! /* Create dataspace for dataset */ + ! Create dataspace for dataset CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create "big" dataspace for "large" attributes */ + ! Create "big" dataspace for "large" attributes CALL h5screate_simple_f(arank, adims2, big_sid, error) CALL check("h5screate_simple_f",error,total_error) - ! /* Loop over type of shared components */ + ! Loop over type of shared components DO test_shared = 0, 2 - ! /* Make copy of file creation property list */ + ! Make copy of file creation property list CALL H5Pcopy_f(fcpl, my_fcpl, error) CALL check("H5Pcopy",error,total_error) - ! /* Set up datatype for attributes */ + ! Set up datatype for attributes CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error) CALL check("H5Tcopy",error,total_error) - ! /* Special setup for each type of shared components */ + ! Special setup for each type of shared components IF( test_shared .EQ. 0) THEN - ! /* Make attributes > 500 bytes shared */ + ! Make attributes > 500 bytes shared CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error) CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error) CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) CALL check(" H5Pset_shared_mesg_index_f",error, total_error) ELSE - ! /* Set up copy of file creation property list */ + ! Set up copy of file creation property list CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error) - ! /* Make attributes > 500 bytes shared */ + ! Make attributes > 500 bytes shared CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) - ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */ + ! Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error) CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error) ENDIF - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Close FCPL copy */ + ! Close FCPL copy CALL h5pclose_f(my_fcpl, error) CALL check("h5pclose_f", error, total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Re-open file */ + ! Re-open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) CALL check("h5open_f",error,total_error) - ! /* Commit datatype to file */ + ! Commit datatype to file IF(test_shared.EQ.2) THEN CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("H5Tcommit",error,total_error) ENDIF - ! /* Set up to query the object creation properties */ + ! Set up to query the object creation properties CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Create datasets */ + ! Create datasets CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) - ! /* Retrieve limits for compact/dense attribute storage */ + ! Retrieve limits for compact/dense attribute storage CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl,error) CALL check("h5pclose_f", error, total_error) - ! /* Add attributes to each dataset, until after converting to dense storage */ + ! Add attributes to each dataset, until after converting to dense storage DO u = 0, (max_compact * 2) - 1 - ! /* Create attribute name */ + ! Create attribute name WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - ! /* Alternate between creating "small" & "big" attributes */ + ! Alternate between creating "small" & "big" attributes IF(MOD(u+1,2).EQ.0)THEN - ! /* Create "small" attribute on first dataset */ + ! Create "small" attribute on first dataset CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u + 1 data_dims(1) = 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ELSE - ! Create "big" attribute on first dataset */ + ! Create "big" attribute on first dataset CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! Write data into the attribute */ + ! Write data into the attribute data_dims(1) = 1 attr_integer_data(1) = u + 1 @@ -1244,19 +1244,19 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ENDIF - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Alternate between creating "small" & "big" attributes */ + ! Alternate between creating "small" & "big" attributes IF(MOD(u+1,2).EQ.0)THEN - ! /* Create "small" attribute on second dataset */ + ! Create "small" attribute on second dataset CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u + 1 data_dims(1) = 1 @@ -1264,12 +1264,12 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) CALL check("h5awrite_f",error,total_error) ELSE - ! /* Create "big" attribute on second dataset */ + ! Create "big" attribute on second dataset CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) -! /* Write data into the attribute */ +! Write data into the attribute attr_integer_data(1) = u + 1 @@ -1278,103 +1278,103 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! CALL check("h5awrite_f",error,total_error) -! /* Check refcount for attribute */ +! Check refcount for attribute ENDIF - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Create new attribute name */ + ! Create new attribute name WRITE(chr2,'(I2.2)') u attrname2 = 'new attr '//chr2 - ! /* Change second dataset's attribute's name */ + ! Change second dataset's attribute's name CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname, attrname2, error, lapl_id=H5P_DEFAULT_F) CALL check("H5Arename_by_name_f",error,total_error) - ! /* Check refcount on attributes now */ + ! Check refcount on attributes now - ! /* Check refcount on renamed attribute */ + ! Check refcount on renamed attribute CALL H5Aopen_f(dataset2, attrname2, attr, error, aapl_id=H5P_DEFAULT_F) CALL check("H5Aopen_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Check refcount on original attribute */ + ! Check refcount on original attribute CALL H5Aopen_f(dataset, attrname, attr, error) CALL check("H5Aopen",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Change second dataset's attribute's name back to original */ + ! Change second dataset's attribute's name back to original CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname2, attrname, error) CALL check("H5Arename_by_name_f",error,total_error) - ! /* Check refcount on attributes now */ + ! Check refcount on attributes now - ! /* Check refcount on renamed attribute */ + ! Check refcount on renamed attribute CALL H5Aopen_f(dataset2, attrname, attr, error) CALL check("H5Aopen",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Check refcount on original attribute */ + ! Check refcount on original attribute - ! /* Check refcount on renamed attribute */ + ! Check refcount on renamed attribute CALL H5Aopen_f(dataset, attrname, attr, error) CALL check("H5Aopen",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO - ! /* Close attribute's datatype */ + ! Close attribute's datatype CALL h5tclose_f(attr_tid, error) CALL check("h5tclose_f",error,total_error) - ! /* Close attribute's datatype */ + ! Close attribute's datatype CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dataset2, error) CALL check("h5dclose_f",error,total_error) - ! /* Unlink datasets with attributes */ + ! Unlink datasets with attributes CALL H5Ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) CALL check("HLdelete",error,total_error) CALL H5Ldelete_f(fid, DSET2_NAME, error) CALL check("HLdelete",error,total_error) - !/* Unlink committed datatype */ + ! Unlink committed datatype IF(test_shared == 2)THEN CALL H5Ldelete_f(fid, TYPE1_NAME, error) CALL check("HLdelete_f",error,total_error) ENDIF - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Check size of file */ + ! Check size of file !filesize = h5_get_file_size(FILENAME); !VERIFY(filesize, empty_filesize, "h5_get_file_size"); ENDDO - ! /* Close dataspaces */ + ! Close dataspaces CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(big_sid, error) @@ -1385,12 +1385,12 @@ END SUBROUTINE test_attr_shared_rename SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_delete_by_idx(): Test basic H5A (attribute) code. !** Tests deleting attribute by index !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -1402,9 +1402,9 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) INTEGER(HID_T), INTENT(IN) :: fapl INTEGER, INTENT(INOUT) :: total_error CHARACTER(LEN=8) :: FileName = "tattr.h5" - INTEGER(HID_T) :: fid ! /* HDF5 File ID */ - INTEGER(HID_T) :: dcpl ! /* Dataset creation property list ID */ - INTEGER(HID_T) :: sid ! /* Dataspace ID */ + INTEGER(HID_T) :: fid ! HDF5 File ID + INTEGER(HID_T) :: dcpl ! Dataset creation property list ID + INTEGER(HID_T) :: sid ! Dataspace ID CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" @@ -1442,40 +1442,40 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) INTEGER :: idx_type INTEGER :: order - INTEGER :: u ! /* Local index variable */ + INTEGER :: u ! Local index variable INTEGER :: Input1 INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T INTEGER :: minusone = -1 data_dims = 0 - ! /* Create dataspace for dataset & attributes */ + ! Create dataspace for dataset & attributes CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Query the attribute creation properties */ + ! Query the attribute creation properties CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - !/* Loop over operating on different indices on link fields */ + ! Loop over operating on different indices on link fields DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F - ! /* Loop over operating in different orders */ + ! Loop over operating in different orders DO order = H5_ITER_INC_F, H5_ITER_DEC_F - ! /* Loop over using index for creation order value */ + ! Loop over using index for creation order value DO i = 1, 2 - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Set attribute creation order tracking & indexing for object */ + ! Set attribute creation order tracking & indexing for object IF(new_format)THEN IF(use_index(i))THEN @@ -1489,7 +1489,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ENDIF - ! /* Create datasets */ + ! Create datasets CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl ) CALL check("h5dcreate_f2",error,total_error) @@ -1500,7 +1500,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl ) CALL check("h5dcreate_f4",error,total_error) - ! /* Work on all the datasets */ + ! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) @@ -1515,36 +1515,36 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) END SELECT - ! /* Check for deleting non-existant attribute */ + ! Check for deleting non-existant attribute !EP CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F) CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, hzero,error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) - ! /* Create attributes, up to limit of compact form */ + ! Create attributes, up to limit of compact form DO u = 0, max_compact - 1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Verify information for new attribute */ + ! Verify information for new attribute CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error ) ENDDO - !/* Check for out of bound deletions */ + ! Check for out of bound deletions CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) @@ -1563,11 +1563,11 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! CALL HDassert(0.AND."Toomanydatasets!") END SELECT - ! /* Delete attributes from compact storage */ + ! Delete attributes from compact storage DO u = 0, max_compact - 2 - ! /* Delete first attribute in appropriate order */ + ! Delete first attribute in appropriate order !EP CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error) @@ -1575,7 +1575,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL check("H5Adelete_by_idx_f",error,total_error) - ! /* Verify the attribute information for first attribute in appropriate order */ + ! Verify the attribute information for first attribute in appropriate order ! HDmemset(&ainfo, 0, sizeof(ainfo)); !EP CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, & @@ -1590,7 +1590,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error) ENDIF - ! /* Verify the name for first attribute in appropriate order */ + ! Verify the name for first attribute in appropriate order size = 7 ! *CHECK* IF NOT THE SAME SIZE CALL h5aget_name_by_idx_f(my_dataset, ".", idx_type, order,INT(0,hsize_t), & @@ -1607,7 +1607,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) ENDDO - ! /* Delete last attribute */ + ! Delete last attribute !EP CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error) CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, hzero, error) @@ -1615,7 +1615,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ENDDO -! /* Work on all the datasets */ +! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) @@ -1629,11 +1629,11 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! CALL HDassert(0.AND."Toomanydatasets!") END SELECT - ! /* Create more attributes, to push into dense form */ + ! Create more attributes, to push into dense form DO u = 0, (max_compact * 2) - 1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -1641,24 +1641,24 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO - ! /* Check for out of bound deletion */ + ! Check for out of bound deletion CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) ENDDO - ! /* Work on all the datasets */ + ! Work on all the datasets DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) @@ -1670,15 +1670,15 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) my_dataset = dset3 END SELECT - ! /* Delete attributes from dense storage */ + ! Delete attributes from dense storage DO u = 0, (max_compact * 2) - 1 - 1 - ! /* Delete first attribute in appropriate order */ + ! Delete first attribute in appropriate order CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error) CALL check("H5Adelete_by_idx_f",error,total_error) - ! /* Verify the attribute information for first attribute in appropriate order */ + ! Verify the attribute information for first attribute in appropriate order CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), & f_corder_valid, corder, cset, data_size, error) @@ -1690,7 +1690,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error) ENDIF - ! /* Verify the name for first attribute in appropriate order */ + ! Verify the name for first attribute in appropriate order ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); size = 7 ! *CHECK* if not the correct size @@ -1709,17 +1709,17 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ENDDO - ! /* Delete last attribute */ + ! Delete last attribute CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error, lapl_id=H5P_DEFAULT_F) CALL check("H5Adelete_by_idx_f",error,total_error) - !/* Check for deletion on empty attribute storage again */ + ! Check for deletion on empty attribute storage again CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) ENDDO - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dset1, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset2, error) @@ -1727,18 +1727,18 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) ENDDO ENDDO ENDDO - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl,error) CALL check("h5pclose_f", error, total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) @@ -1746,12 +1746,12 @@ END SUBROUTINE test_attr_delete_by_idx SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_shared_delete(): Test basic H5A (attribute) code. !** Tests deleting shared attributes in "compact" & "dense" storage !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -1796,77 +1796,77 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank - ! /* Output message about test being performed */ + ! Output message about test being performed - ! /* Initialize "big" attribute DATA */ - ! /* Create dataspace for dataset */ + ! Initialize "big" attribute DATA + ! Create dataspace for dataset CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - !/* Create "big" dataspace for "large" attributes */ + ! Create "big" dataspace for "large" attributes CALL h5screate_simple_f(arank, adims2, big_sid, error) CALL check("h5screate_simple_f",error,total_error) - ! /* Loop over type of shared components */ + ! Loop over type of shared components DO test_shared = 0, 2 - ! /* Make copy of file creation property list */ + ! Make copy of file creation property list CALL H5Pcopy_f(fcpl, my_fcpl, error) CALL check("H5Pcopy",error,total_error) - ! /* Set up datatype for attributes */ + ! Set up datatype for attributes CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error) CALL check("H5Tcopy",error,total_error) - ! /* Special setup for each type of shared components */ + ! Special setup for each type of shared components IF( test_shared .EQ. 0) THEN - ! /* Make attributes > 500 bytes shared */ + ! Make attributes > 500 bytes shared CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error) CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error) CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) CALL check(" H5Pset_shared_mesg_index_f",error, total_error) ELSE - ! /* Set up copy of file creation property list */ + ! Set up copy of file creation property list CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error) - ! /* Make attributes > 500 bytes shared */ + ! Make attributes > 500 bytes shared CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) - ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */ + ! Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error) CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error) ENDIF - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Close FCPL copy */ + ! Close FCPL copy CALL h5pclose_f(my_fcpl, error) CALL check("h5pclose_f", error, total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Re-open file */ + ! Re-open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) CALL check("h5open_f",error,total_error) - ! /* Commit datatype to file */ + ! Commit datatype to file IF(test_shared.EQ.2) THEN CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("H5Tcommit",error,total_error) ENDIF - ! /* Set up to query the object creation properties */ + ! Set up to query the object creation properties CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Create datasets */ + ! Create datasets CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) @@ -1874,42 +1874,42 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) - ! /* Retrieve limits for compact/dense attribute storage */ + ! Retrieve limits for compact/dense attribute storage CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl,error) CALL check("h5pclose_f", error, total_error) - ! /* Add attributes to each dataset, until after converting to dense storage */ + ! Add attributes to each dataset, until after converting to dense storage DO u = 0, (max_compact * 2) - 1 - ! /* Create attribute name */ + ! Create attribute name WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - ! /* Alternate between creating "small" & "big" attributes */ + ! Alternate between creating "small" & "big" attributes IF(MOD(u+1,2).EQ.0)THEN - ! /* Create "small" attribute on first dataset */ + ! Create "small" attribute on first dataset CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u + 1 data_dims(1) = 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ELSE - ! Create "big" attribute on first dataset */ + ! Create "big" attribute on first dataset CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error) CALL check("h5acreate_f",error,total_error) - ! Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u + 1 data_dims(1) = 1 @@ -1918,31 +1918,31 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ENDIF - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Alternate between creating "small" & "big" attributes */ + ! Alternate between creating "small" & "big" attributes IF(MOD(u+1,2).EQ.0)THEN - ! /* Create "small" attribute on second dataset */ + ! Create "small" attribute on second dataset CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute attr_integer_data(1) = u + 1 data_dims(1) = 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ELSE - ! /* Create "big" attribute on second dataset */ + ! Create "big" attribute on second dataset CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) -! /* Write data into the attribute */ +! Write data into the attribute attr_integer_data(1) = u + 1 @@ -1951,21 +1951,21 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CALL check("h5awrite_f",error,total_error) ENDIF - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO - ! /* Delete attributes from second dataset */ + ! Delete attributes from second dataset DO u = 0, max_compact*2-1 - ! /* Create attribute name */ + ! Create attribute name WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - ! /* Delete second dataset's attribute */ + ! Delete second dataset's attribute CALL H5Adelete_by_name_f(fid, DSET2_NAME, attrname,error,lapl_id=H5P_DEFAULT_F) CALL check("H5Adelete_by_name", error, total_error) @@ -1973,31 +1973,31 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CALL check("h5aopen_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO - ! /* Close attribute's datatype */ + ! Close attribute's datatype CALL h5tclose_f(attr_tid, error) CALL check("h5tclose_f",error,total_error) - ! /* Close Datasets */ + ! Close Datasets CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dataset2, error) CALL check("h5dclose_f",error,total_error) - ! /* Unlink datasets WITH attributes */ + ! Unlink datasets WITH attributes CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) CALL check("H5Ldelete_f", error, total_error) CALL h5ldelete_f(fid, DSET2_NAME, error) CALL check("H5Ldelete_f", error, total_error) - ! /* Unlink committed datatype */ + ! Unlink committed datatype IF( test_shared == 2) THEN CALL h5ldelete_f(fid, TYPE1_NAME, error) @@ -2005,13 +2005,13 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ENDIF - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) ENDDO - ! /* Close dataspaces */ + ! Close dataspaces CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(big_sid, error) @@ -2023,12 +2023,12 @@ END SUBROUTINE test_attr_shared_delete SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) -!/**************************************************************** +!*************************************************************** !** !** test_attr_dense_open(): Test basic H5A (attribute) code. !** Tests opening attributes in "dense" storage !** -!****************************************************************/ +!*************************************************************** USE HDF5 USE TH5_MISC @@ -2064,73 +2064,73 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) data_dims = 0 - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Re-open file */ + ! Re-open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL check("h5open_f",error,total_error) - ! /* Create dataspace for dataset */ + ! Create dataspace for dataset CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Query the group creation properties */ + ! Query the group creation properties CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Enable creation order tracking on attributes, so creation order tests work */ + ! Enable creation order tracking on attributes, so creation order tests work CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_TRACKED_F, error) CALL check("H5Pset_attr_creation_order",error,total_error) - ! /* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, & lcpl_id=H5P_DEFAULT_F, dcpl_id=dcpl, dapl_id=H5P_DEFAULT_F) CALL check("h5dcreate_f",error,total_error) - ! /* Retrieve limits for compact/dense attribute storage */ + ! Retrieve limits for compact/dense attribute storage CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f",error,total_error) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) - ! /* Add attributes, until just before converting to dense storage */ + ! Add attributes, until just before converting to dense storage DO u = 0, max_compact - 1 - ! /* Create attribute */ + ! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Verify attributes written so far */ + ! Verify attributes written so far CALL test_attr_dense_verify(dataset, u, total_error) ENDDO ! -! /* Add one more attribute, to push into "dense" storage */ -! /* Create attribute */ +! Add one more attribute, to push into "dense" storage +! Create attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -2138,47 +2138,47 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write data into the attribute */ + ! Write data into the attribute data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) - ! /* Verify all the attributes written */ + ! Verify all the attributes written ! ret = test_attr_dense_verify(dataset, (u + 1)); ! CHECK(ret, FAIL, "test_attr_dense_verify"); - ! /* CLOSE Dataset */ + ! CLOSE Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) - ! /* Unlink dataset with attributes */ + ! Unlink dataset with attributes CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) CALL check("H5Ldelete_f", error, total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Check size of file */ + ! Check size of file ! filesize = h5_get_file_size(FILENAME); ! VERIFY(filesize, empty_filesize, "h5_get_file_size") END SUBROUTINE test_attr_dense_open -!/**************************************************************** +!*************************************************************** !** !** test_attr_dense_verify(): Test basic H5A (attribute) code. !** Verify attributes on object !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) @@ -2206,21 +2206,21 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) data_dims = 0 - ! /* Retrieve the current # of reported errors */ + ! Retrieve the current # of reported errors ! old_nerrs = GetTestNumErrs(); - ! /* Re-open all the attributes by name and verify the data */ + ! Re-open all the attributes by name and verify the data DO u = 0, max_attr -1 - ! /* Open attribute */ + ! Open attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 CALL h5aopen_f(loc_id, attrname, attr, error) CALL check("h5aopen_f",error,total_error) - ! /* Read data from the attribute */ + ! Read data from the attribute ! value = 103 data_dims(1) = 1 @@ -2229,22 +2229,22 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) CALL CHECK("H5Aread_F", error, total_error) CALL VERIFY("H5Aread_F", value, u, total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO - ! /* Re-open all the attributes by index and verify the data */ + ! Re-open all the attributes by index and verify the data DO u=0, max_attr-1 - ! /* Open attribute */ + ! Open attribute CALL H5Aopen_by_idx_f(loc_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(u,HSIZE_T), & attr, error, aapl_id=H5P_DEFAULT_F) - ! /* Verify Name */ + ! Verify Name WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -2255,26 +2255,26 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) WRITE(*,*) 'ERROR: attribute name different: attr_name = ',check_name, ', should be ', attrname total_error = total_error + 1 ENDIF - ! /* Read data from the attribute */ + ! Read data from the attribute data_dims(1) = 1 CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error) CALL CHECK("H5Aread_f", error, total_error) CALL VERIFY("H5Aread_f", value, u, total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ENDDO END SUBROUTINE test_attr_dense_verify -!/**************************************************************** +!*************************************************************** !** !** test_attr_corder_create_empty(): Test basic H5A (attribute) code. !** Tests basic code to create objects with attribute creation order info !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) @@ -2300,30 +2300,30 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) INTEGER :: crt_order_flags INTEGER :: minusone = -1 - ! /* Output message about test being performed */ + ! Output message about test being performed ! WRITE(*,*) " - Testing Basic Code for Attributes with Creation Order Info" - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - ! /* Get creation order indexing on object */ + ! Get creation order indexing on object CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) CALL check("H5Pget_attr_creation_order_f",error,total_error) CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error) - ! /* Setting invalid combination of a attribute order creation order indexing on should fail */ + ! Setting invalid combination of a attribute order creation order indexing on should fail CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_INDEXED_F, error) CALL VERIFY("H5Pset_attr_creation_order_f",error , minusone, total_error) CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) CALL check("H5Pget_attr_creation_order_f",error,total_error) CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error) - ! /* Set attribute creation order tracking & indexing for object */ + ! Set attribute creation order tracking & indexing for object CALL h5pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error) CALL check("H5Pset_attr_creation_order_f",error,total_error) @@ -2332,72 +2332,72 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , & IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error) - ! /* Create dataspace for dataset */ + ! Create dataspace for dataset CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, & lcpl_id=H5P_DEFAULT_F, dapl_id=H5P_DEFAULT_F, dcpl_id=dcpl) CALL check("h5dcreate_f",error,total_error) - ! /* Close dataspace */ + ! Close dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) - ! /* Close Dataset */ + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Re-open file */ + ! Re-open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL check("h5open_f",error,total_error) - ! /* Open dataset created */ + ! Open dataset created CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F ) CALL check("h5dopen_f",error,total_error) - ! /* Retrieve dataset creation property list for group */ + ! Retrieve dataset creation property list for group CALL H5Dget_create_plist_f(dataset, dcpl, error) CALL check("H5Dget_create_plist_f",error,total_error) - ! /* Query the attribute creation properties */ + ! Query the attribute creation properties CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) CALL check("H5Pget_attr_creation_order_f",error,total_error) CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , & IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error ) - ! /* Close property list */ + ! Close property list CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) - ! /* Close Dataset */ + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) END SUBROUTINE test_attr_corder_create_basic -!/**************************************************************** +!*************************************************************** !** !** test_attr_basic_write(): Test basic H5A (attribute) code. !** Tests integer attributes on both datasets and groups !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_attr_basic_write(fapl, total_error) @@ -2451,97 +2451,97 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) attr_data1a(3) = -99890 - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid1, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Create dataspace for dataset */ + ! Create dataspace for dataset CALL h5screate_simple_f(rank1, dims1, sid1, error, maxdims1) CALL check("h5screate_simple_f",error,total_error) - ! /* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(fid1, DSET1_NAME, H5T_NATIVE_CHARACTER, sid1, dataset, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F ) CALL check("h5dcreate_f",error,total_error) - ! /* Create dataspace for attribute */ + ! Create dataspace for attribute CALL h5screate_simple_f(ATTR1_RANK, dimsa, sid2, error) CALL check("h5screate_simple_f",error,total_error) - ! /* Try to create an attribute on the file (should create an attribute on root group) */ + ! Try to create an attribute on the file (should create an attribute on root group) CALL h5acreate_f(fid1, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, aapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Open the root group */ + ! Open the root group CALL H5Gopen_f(fid1, "/", group, error, H5P_DEFAULT_F) CALL check("H5Gopen_f",error,total_error) - ! /* Open attribute again */ + ! Open attribute again CALL h5aopen_f(group, ATTR1_NAME, attr, error) CALL check("h5aopen_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Close root group */ + ! Close root group CALL H5Gclose_f(group, error) CALL check("h5gclose_f",error,total_error) - ! /* Create an attribute for the dataset */ + ! Create an attribute for the dataset CALL h5acreate_f(dataset, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write attribute information */ + ! Write attribute information CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, dimsa, error) CALL check("h5awrite_f",error,total_error) - ! /* Create an another attribute for the dataset */ + ! Create an another attribute for the dataset CALL h5acreate_f(dataset, ATTR1A_NAME, H5T_NATIVE_INTEGER, sid2, attr2, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - ! /* Write attribute information */ + ! Write attribute information CALL h5awrite_f(attr2, H5T_NATIVE_INTEGER, attr_data1a, dimsa, error) CALL check("h5awrite_f",error,total_error) - ! /* Check storage size for attribute */ + ! Check storage size for attribute CALL h5aget_storage_size_f(attr, attr_size, error) CALL check("h5aget_storage_size_f",error,total_error) !EP CALL VERIFY("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error) - ! /* Read attribute information immediately, without closing attribute */ + ! Read attribute information immediately, without closing attribute CALL h5aread_f(attr, H5T_NATIVE_INTEGER, read_data1, dimsa, error) CALL check("h5aread_f",error,total_error) - ! /* Verify values read in */ + ! Verify values read in DO i = 1, ATTR1_DIM1 CALL VERIFY('h5aread_f',attr_data1(i),read_data1(i), total_error) ENDDO - ! /* CLOSE attribute */ + ! CLOSE attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr2, error) CALL check("h5aclose_f",error,total_error) - ! /* change attribute name */ + ! change attribute name CALL H5Arename_f(dataset, ATTR1_NAME, ATTR_TMP_NAME, error) CALL check("H5Arename_f", error, total_error) - ! /* Open attribute again */ + ! Open attribute again CALL h5aopen_f(dataset, ATTR_TMP_NAME, attr, error) CALL check("h5aopen_f",error,total_error) - ! /* Verify new attribute name */ + ! Verify new attribute name ! Set a deliberately small size check_name = ' ' ! need to initialize or does not pass test @@ -2572,7 +2572,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check('H5Aget_name_f',error,total_error) CALL VerifyString('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) @@ -2580,22 +2580,22 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(sid2, error) CALL check("h5sclose_f",error,total_error) - !/* Close Dataset */ + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid1, error) CALL check("h5fclose_f",error,total_error) END SUBROUTINE test_attr_basic_write -!/**************************************************************** +!*************************************************************** !** !** test_attr_many(): Test basic H5A (attribute) code. !** Tests storing lots of attributes !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) @@ -2630,20 +2630,20 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) data_dims = 0 - !/* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Create dataspace for attribute */ + ! Create dataspace for attribute CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) - ! /* Create group for attributes */ + ! Create group for attributes CALL H5Gcreate_f(fid, GROUP1_NAME, gid, error) CALL check("H5Gcreate_f", error, total_error) - ! /* Create many attributes */ + ! Create many attributes IF(new_format)THEN nattr = 250 @@ -2687,21 +2687,21 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) ENDDO - ! /* Close group */ + ! Close group CALL H5Gclose_f(gid, error) CALL check("h5gclose_f",error,total_error) - ! /* Close file */ + ! Close file CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! /* Close dataspaces */ + ! Close dataspaces CALL h5sclose_f(sid, error) CALL check("h5sclose_f",error,total_error) END SUBROUTINE test_attr_many -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: attr_open_check ! * ! * Purpose: Check opening attribute on an object @@ -2713,7 +2713,7 @@ END SUBROUTINE test_attr_many ! * March 21, 2008 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) @@ -2738,10 +2738,10 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) INTEGER(HSIZE_T) :: storage_size ! attributes storage requirements CHARACTER(LEN=2) :: chr2 INTEGER(HID_T) attr_id - ! /* Open each attribute on object by index and check that it's the correct one */ + ! Open each attribute on object by index and check that it's the correct one DO u = 0, max_attrs-1 - ! /* Open the attribute */ + ! Open the attribute WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -2751,12 +2751,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CALL check("h5aopen_f",error,total_error) - ! /* Get the attribute's information */ + ! Get the attribute's information CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_f",error,total_error) - ! /* Check that the object's attributes are correct */ + ! Check that the object's attributes are correct CALL VERIFY("h5aget_info_f.corder",corder,u,total_error) CALL Verifylogical("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error) CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error) @@ -2766,18 +2766,18 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) - ! /* Open the attribute */ + ! Open the attribute CALL H5Aopen_by_name_f(obj_id, ".", attrname, attr_id, error, lapl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) CALL check("H5Aopen_by_name_f", error, total_error) CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_f",error,total_error) - ! /* Check the attribute's information */ + ! Check the attribute's information CALL VERIFY("h5aget_info_f",corder,u,total_error) CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error) CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error) @@ -2785,21 +2785,21 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CALL check("h5aget_storage_size_f",error,total_error) CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) - ! /* Open the attribute */ + ! Open the attribute CALL H5Aopen_by_name_f(fid, dsetname, attrname, attr_id, error) CALL check("H5Aopen_by_name_f", error, total_error) - ! /* Get the attribute's information */ + ! Get the attribute's information CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_f",error,total_error) - ! /* Check the attribute's information */ + ! Check the attribute's information CALL VERIFY("h5aget_info_f",corder,u,total_error) CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error) CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error) @@ -2807,7 +2807,7 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CALL check("h5aget_storage_size_f",error,total_error) CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error) - ! /* Close attribute */ + ! Close attribute CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) ENDDO diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90 index 82ba27c..a7d45f2 100644 --- a/fortran/test/tH5E_F03.f90 +++ b/fortran/test/tH5E_F03.f90 @@ -39,11 +39,11 @@ MODULE test_my_hdf5_error_handler CONTAINS -!/**************************************************************** +!*************************************************************** !** !** my_hdf5_error_handler: Custom error callback routine. !** -!****************************************************************/ +!*************************************************************** INTEGER FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C) @@ -173,10 +173,10 @@ SUBROUTINE test_error(total_error) !!$#ifdef H5_USE_16_API !!$ if (old_func != (H5E_auto_t)H5Eprint) !!$ TEST_ERROR; -!!$#else /* H5_USE_16_API */ +!!$#else H5_USE_16_API !!$ if (old_func != (H5E_auto2_t)H5Eprint2) !!$ TEST_ERROR; -!!$#endif /* H5_USE_16_API */ +!!$#endif H5_USE_16_API ! set the customized error handling routine diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 index 931a046..0b3c275 100644 --- a/fortran/test/tH5F.f90 +++ b/fortran/test/tH5F.f90 @@ -141,13 +141,11 @@ CONTAINS CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) CALL check("h5fcreate_f",error,total_error) - ! !Create group "/G" inside file "mount1.h5". ! CALL h5gcreate_f(file1_id, "/G", gid, error) CALL check("h5gcreate_f",error,total_error) - ! !close file and group identifiers. ! diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 index 5e6f50a..ab75163 100644 --- a/fortran/test/tH5G_1_8.f90 +++ b/fortran/test/tH5G_1_8.f90 @@ -41,7 +41,7 @@ SUBROUTINE group_test(cleanup, total_error) LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */ + INTEGER(HID_T) :: fapl, fapl2, my_fapl ! File access property lists INTEGER :: error, ret_total_error @@ -49,15 +49,15 @@ SUBROUTINE group_test(cleanup, total_error) CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) CALL check("H5Pcreate_f",error, total_error) - ! /* Copy the file access property list */ + ! Copy the file access property list CALL H5Pcopy_f(fapl, fapl2, error) CALL check("H5Pcopy_f",error, total_error) - ! /* Set the "use the latest version of the format" bounds for creating objects in the file */ + ! Set the "use the latest version of the format" bounds for creating objects in the file CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) - ! /* Check for FAPL to USE */ + ! Check for FAPL to USE my_fapl = fapl2 ret_total_error = 0 @@ -121,7 +121,7 @@ SUBROUTINE group_test(cleanup, total_error) END SUBROUTINE group_test -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: group_info ! * ! * Purpose: Create a group with creation order indices and test querying @@ -135,7 +135,7 @@ END SUBROUTINE group_test ! * February 18, 2008 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE group_info(cleanup, fapl, total_error) @@ -146,21 +146,21 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl - INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ + INTEGER(HID_T) :: gcpl_id ! Group creation property list ID - INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ - INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" - INTEGER :: idx_type ! /* Type of index to operate on */ - INTEGER :: order, iorder ! /* Order within in the index */ - LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! /* Use index on creation order values */ + INTEGER :: idx_type ! Type of index to operate on + INTEGER :: order, iorder ! Order within in the index + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! Use index on creation order values CHARACTER(LEN=6), PARAMETER :: prefix = 'links0' - CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */ + CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! File name INTEGER :: Input1 - INTEGER(HID_T) :: group_id ! /* Group ID */ - INTEGER(HID_T) :: soft_group_id ! /* Group ID for soft links */ + INTEGER(HID_T) :: group_id ! Group ID + INTEGER(HID_T) :: soft_group_id ! Group ID for soft links - INTEGER :: i ! /* Local index variables */ + INTEGER :: i ! Local index variables INTEGER :: storage_type ! Type of storage for links in group: ! H5G_STORAGE_TYPE_COMPACT: Compact storage ! H5G_STORAGE_TYPE_DENSE: Indexed storage @@ -168,34 +168,34 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: nlinks ! Number of links in group INTEGER :: max_corder ! Current maximum creation order value for group - INTEGER :: u,v ! /* Local index variables */ + INTEGER :: u,v ! Local index variables CHARACTER(LEN=2) :: chr2 - INTEGER(HID_T) :: group_id2, group_id3 ! /* Group IDs */ - CHARACTER(LEN=7) :: objname ! /* Object name */ - CHARACTER(LEN=7) :: objname2 ! /* Object name */ - CHARACTER(LEN=19) :: valname ! /* Link value */ + INTEGER(HID_T) :: group_id2, group_id3 ! Group IDs + CHARACTER(LEN=7) :: objname ! Object name + CHARACTER(LEN=7) :: objname2 ! Object name + CHARACTER(LEN=19) :: valname ! Link value CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" CHARACTER(LEN=17), PARAMETER :: CORDER_SOFT_GROUP_NAME = "corder_soft_group" - INTEGER(HID_T) :: file_id ! /* File ID */ - INTEGER :: error ! /* Generic return value */ + INTEGER(HID_T) :: file_id ! File ID + INTEGER :: error ! Generic return value LOGICAL :: mounted LOGICAL :: cleanup - ! /* Create group creation property list */ + ! Create group creation property list CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) CALL check("H5Pcreate_f", error, total_error) - ! /* Query the group creation properties */ + ! Query the group creation properties CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error) CALL check("H5Pget_link_phase_change_f", error, total_error) - ! /* Loop over operating on different indices on link fields */ + ! Loop over operating on different indices on link fields DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F - ! /* Loop over operating in different orders */ + ! Loop over operating in different orders DO iorder = H5_ITER_INC_F, H5_ITER_NATIVE_F - ! /* Loop over using index for creation order value */ + ! Loop over using index for creation order value DO i = 1, 2 - ! /* Print appropriate test message */ + ! Print appropriate test message IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN IF(iorder == H5_ITER_INC_F)THEN order = H5_ITER_INC_F @@ -244,11 +244,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ENDIF END IF - ! /* Create file */ + ! Create file CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("H5Fcreate_f", error, total_error) - ! /* Set creation order tracking & indexing on group */ + ! Set creation order tracking & indexing on group IF(use_index(i))THEN Input1 = H5P_CRT_ORDER_INDEXED_F ELSE @@ -257,103 +257,103 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) CALL check("H5Pset_link_creation_order_f", error, total_error) - ! /* Create group with creation order tracking on */ + ! Create group with creation order tracking on CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id) CALL check("H5Gcreate_f", error, total_error) - ! /* Create group with creation order tracking on for soft links */ + ! Create group with creation order tracking on for soft links CALL H5Gcreate_f(file_id, CORDER_SOFT_GROUP_NAME, soft_group_id, error, & OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id) CALL check("H5Gcreate_f", error, total_error) - ! /* Check for out of bound query by index on empty group, should fail */ + ! Check for out of bound query by index on empty group, should fail CALL H5Gget_info_by_idx_f(group_id, ".", H5_INDEX_NAME_F, order, INT(0,HSIZE_T), & storage_type, nlinks, max_corder, error) CALL VERIFY("H5Gget_info_by_idx_f", error, -1, total_error) - ! /* Create several links, up to limit of compact form */ + ! Create several links, up to limit of compact form DO u = 0, max_compact-1 - ! /* Make name for link */ + ! Make name for link WRITE(chr2,'(I2.2)') u objname = 'fill '//chr2 - ! /* Create hard link, with group object */ + ! Create hard link, with group object CALL H5Gcreate_f(group_id, objname, group_id2, error, OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id) CALL check("H5Gcreate_f", error, total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error, mounted) CALL check("H5Gget_info_f", error, total_error) - ! /* Check (new/empty) group's information */ + ! Check (new/empty) group's information CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error) CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error) CALL verifyLogical("H5Gget_info_f.mounted", mounted,.FALSE.,total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted) CALL check("H5Gget_info_by_name_f", error, total_error) - ! /* Check (new/empty) group's information */ + ! Check (new/empty) group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error) CALL verifyLogical("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name", error, total_error) - ! /* Check (new/empty) group's information */ + ! Check (new/empty) group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error) - ! /* Create objects in new group created */ + ! Create objects in new group created DO v = 0, u - ! /* Make name for link */ + ! Make name for link WRITE(chr2,'(I2.2)') v objname2 = 'fill '//chr2 - ! /* Create hard link, with group object */ + ! Create hard link, with group object CALL H5Gcreate_f(group_id2, objname2, group_id3, error ) CALL check("H5Gcreate_f", error, total_error) - ! /* Close group created */ + ! Close group created CALL H5Gclose_f(group_id3, error) CALL check("H5Gclose_f", error, total_error) ENDDO - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_f", error, total_error) - ! /* Check (new) group's information */ + ! Check (new) group's information CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) - ! /* Check (new) group's information */ + ! Check (new) group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f",max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) - ! /* Check (new) group's information */ + ! Check (new) group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) - ! /* Retrieve group's information */ + ! Retrieve group's information IF(order.NE.H5_ITER_NATIVE_F)THEN IF(order.EQ.H5_ITER_INC_F) THEN CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), & @@ -366,72 +366,72 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error) CALL check("H5Gget_info_by_idx_f", error, total_error) ENDIF - ! /* Check (new) group's information */ + ! Check (new) group's information CALL VERIFY("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_idx_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_by_idx_f", nlinks, u+1, total_error) ENDIF - ! /* Close group created */ + ! Close group created CALL H5Gclose_f(group_id2, error) CALL check("H5Gclose_f", error, total_error) - ! /* Retrieve main group's information */ + ! Retrieve main group's information CALL H5Gget_info_f(group_id, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_f", error, total_error) - ! /* Check main group's information */ + ! Check main group's information CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) - ! /* Retrieve main group's information, by name */ + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) - ! /* Check main group's information */ + ! Check main group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) - ! /* Retrieve main group's information, by name */ + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F) CALL check("H5Gget_info_by_name_f", error, total_error) - ! /* Check main group's information */ + ! Check main group's information CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) - ! /* Create soft link in another group, to objects in main group */ + ! Create soft link in another group, to objects in main group valname = CORDER_GROUP_NAME//objname CALL H5Lcreate_soft_f(valname, soft_group_id, objname, error, H5P_DEFAULT_F, H5P_DEFAULT_F) - ! /* Retrieve soft link group's information, by name */ + ! Retrieve soft link group's information, by name CALL H5Gget_info_f(soft_group_id, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_f", error, total_error) - ! /* Check soft link group's information */ + ! Check soft link group's information CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) ENDDO - ! /* Close the groups */ + ! Close the groups CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(soft_group_id, error) CALL check("H5Gclose_f", error, total_error) - ! /* Close the file */ + ! Close the file CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) ENDDO ENDDO ENDDO - ! /* Free resources */ + ! Free resources CALL H5Pclose_f(gcpl_id, error) CALL check("H5Pclose_f", error, total_error) @@ -441,7 +441,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) END SUBROUTINE group_info -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: timestamps ! * ! * Purpose: Verify that disabling tracking timestamps for an object @@ -452,7 +452,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * February 20, 2008 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE timestamps(cleanup, fapl, total_error) @@ -463,15 +463,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl - INTEGER(HID_T) :: file_id !/* File ID */ - INTEGER(HID_T) :: group_id !/* Group ID */ - INTEGER(HID_T) :: group_id2 !/* Group ID */ - INTEGER(HID_T) :: gcpl_id !/* Group creation property list ID */ - INTEGER(HID_T) :: gcpl_id2 !/* Group creation property list ID */ + INTEGER(HID_T) :: file_id ! File ID + INTEGER(HID_T) :: group_id ! Group ID + INTEGER(HID_T) :: group_id2 ! Group ID + INTEGER(HID_T) :: gcpl_id ! Group creation property list ID + INTEGER(HID_T) :: gcpl_id2 ! Group creation property list ID CHARACTER(LEN=6), PARAMETER :: prefix = 'links9' - CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */ - ! /* Timestamp macros */ + CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! File name + ! Timestamp macros CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_1="timestamp1" CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_2="timestamp2" LOGICAL :: track_times @@ -479,58 +479,58 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: error - ! /* Print test message */ + ! Print test message ! WRITE(*,*) "timestamps on objects" - ! /* Create group creation property list */ + ! Create group creation property list CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) CALL check("H5Pcreate_f", error, total_error) - ! /* Query the object timestamp setting */ + ! Query the object timestamp setting CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) CALL check("H5Pget_obj_track_times_f", error, total_error) - !/* Check default timestamp information */ + ! Check default timestamp information CALL VerifyLogical("H5Pget_obj_track_times",track_times,.TRUE.,total_error) - ! /* Set a non-default object timestamp setting */ + ! Set a non-default object timestamp setting CALL H5Pset_obj_track_times_f(gcpl_id, .FALSE., error) CALL check("H5Pset_obj_track_times_f", error, total_error) - ! /* Query the object timestamp setting */ + ! Query the object timestamp setting CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) CALL check("H5Pget_obj_track_times_f", error, total_error) - ! /* Check default timestamp information */ + ! Check default timestamp information CALL VerifyLogical("H5Pget_obj_track_times",track_times,.FALSE.,total_error) - ! /* Create file */ + ! Create file !h5_fixname(FILENAME[0], fapl, filename, sizeof filename); CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f",error,total_error) - ! /* Create group with non-default object timestamp setting */ + ! Create group with non-default object timestamp setting CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_1, group_id, error, & OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id, H5P_DEFAULT_F) CALL check("h5fcreate_f",error,total_error) - ! /* Close the group creation property list */ + ! Close the group creation property list CALL H5Pclose_f(gcpl_id, error) CALL check("H5Pclose_f", error, total_error) - ! /* Create group with default object timestamp setting */ + ! Create group with default object timestamp setting CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, & OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5fcreate_f",error,total_error) - ! /* Retrieve the new groups' creation properties */ + ! Retrieve the new groups' creation properties CALL H5Gget_create_plist_f(group_id, gcpl_id, error) CALL check("H5Gget_create_plist", error, total_error) CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error) CALL check("H5Gget_create_plist", error, total_error) - ! /* Query & verify the object timestamp settings */ + ! Query & verify the object timestamp settings CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error) @@ -538,11 +538,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error) -! /* Query the object information for each group */ +! Query the object information for each group ! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR ! if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR -!!$ /* Sanity check object information for each group */ +!!$ Sanity check object information for each group !!$ if(oinfo.atime != 0) TEST_ERROR !!$ if(oinfo.mtime != 0) TEST_ERROR !!$ if(oinfo.ctime != 0) TEST_ERROR @@ -556,40 +556,40 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR !!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR - ! /* Close the property lists */ + ! Close the property lists CALL H5Pclose_f(gcpl_id, error) CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(gcpl_id2, error) CALL check("H5Pclose_f", error, total_error) - ! /* Close the groups */ + ! Close the groups CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(group_id2, error) CALL check("H5Gclose_f", error, total_error) - !/* Close the file */ + ! Close the file CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) - !/* Re-open the file */ + ! Re-open the file CALL h5fopen_f(FileName, H5F_ACC_RDONLY_F, file_id, error, H5P_DEFAULT_F) CALL check("h5fopen_f",error,total_error) - !/* Open groups */ + ! Open groups CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_1, group_id, error) ! with no optional param. CALL check("H5Gopen_f", error, total_error) CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, H5P_DEFAULT_F) ! with optional param. CALL check("H5Gopen_f", error, total_error) - ! /* Retrieve the new groups' creation properties */ + ! Retrieve the new groups' creation properties CALL H5Gget_create_plist_f(group_id, gcpl_id, error) CALL check("H5Gget_create_plist", error, total_error) CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error) CALL check("H5Gget_create_plist", error, total_error) - ! /* Query & verify the object timestamp settings */ + ! Query & verify the object timestamp settings CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) CALL check("H5Pget_obj_track_times_f", error, total_error) @@ -598,11 +598,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error) !!$ -!!$ /* Query the object information for each group */ +!!$ Query the object information for each group !!$ if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR !!$ if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR !!$ -!!$ /* Sanity check object information for each group */ +!!$ Sanity check object information for each group !!$ if(oinfo.atime != 0) TEST_ERROR !!$ if(oinfo.mtime != 0) TEST_ERROR !!$ if(oinfo.ctime != 0) TEST_ERROR @@ -616,19 +616,19 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR !!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR - ! /* Close the property lists */ + ! Close the property lists CALL H5Pclose_f(gcpl_id, error) CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(gcpl_id2, error) CALL check("H5Pclose_f", error, total_error) - ! /* Close the groups */ + ! Close the groups CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(group_id2, error) CALL check("H5Gclose_f", error, total_error) - !/* Close the file */ + ! Close the file CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) @@ -637,7 +637,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) END SUBROUTINE timestamps -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: mklinks ! * ! * Purpose: Build a file with assorted links. @@ -649,7 +649,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE mklinks(fapl, total_error) @@ -680,29 +680,29 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! WRITE(*,*) "link creation (w/new group format)" - ! /* Create a file */ + ! Create a file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file, error, H5P_DEFAULT_F, fapl) CALL check("mklinks.h5fcreate_f",error,total_error) CALL h5screate_simple_f(arank, adims2, scalar, error) CALL check("mklinks.h5screate_simple_f",error,total_error) - !/* Create a group */ + ! Create a group CALL H5Gcreate_f(file, "grp1", grp, error) CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(grp, error) CALL check("h5gclose_f",error,total_error) - !/* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(file, "d1", H5T_NATIVE_INTEGER, scalar, d1, error) CALL check("h5dcreate_f",error,total_error) CALL h5dclose_f(d1, error) CALL check("h5dclose_f",error,total_error) - !/* Create a hard link */ + ! Create a hard link CALL H5Lcreate_hard_f(file, "d1", INT(H5L_SAME_LOC_F,HID_T), "grp1/hard", error) CALL check("H5Lcreate_hard_f", error, total_error) - !/* Create a symbolic link */ + ! Create a symbolic link CALL H5Lcreate_soft_f("/d1", file, "grp1/soft",error) CALL check("H5Lcreate_soft_f", error, total_error) @@ -718,14 +718,14 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! should be '/d1' + NULL character = 4 CALL VERIFY("H5Lget_info_by_idx_f", INT(val_size), 4, total_error) - !/* Create a symbolic link to something that doesn't exist */ + ! Create a symbolic link to something that doesn't exist CALL H5Lcreate_soft_f("foobar", file, "grp1/dangle",error) - !/* Create a recursive symbolic link */ + ! Create a recursive symbolic link CALL H5Lcreate_soft_f("/grp1/recursive", file, "/grp1/recursive",error) - !/* Close */ + ! Close CALL h5sclose_f(scalar, error) CALL check("h5sclose_f",error,total_error) CALL h5fclose_f(file, error) @@ -733,7 +733,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) END SUBROUTINE mklinks -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: test_move_preserves ! * ! * Purpose: Tests that moving and renaming links preserves their @@ -745,7 +745,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE test_move_preserves(fapl_id, total_error) @@ -758,20 +758,20 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER(HID_T):: file_id INTEGER(HID_T):: group_id - INTEGER(HID_T):: fcpl_id ! /* Group creation property list ID */ + INTEGER(HID_T):: fcpl_id ! Group creation property list ID INTEGER(HID_T):: lcpl_id !H5O_info_t oinfo; !H5L_info_t linfo; INTEGER :: old_cset INTEGER :: old_corder !H5T_cset_t old_cset; - !int64_t old_corder; /* Creation order value of link */ + !int64_t old_corder; Creation order value of link !time_t old_modification_time; !time_t curr_time; - !unsigned crt_order_flags; /* Status of creation order info for GCPL */ + !unsigned crt_order_flags; Status of creation order info for GCPL !char filename[1024]; - INTEGER :: crt_order_flags ! /* Status of creation order info for GCPL */ + INTEGER :: crt_order_flags ! Status of creation order info for GCPL CHARACTER(LEN=12), PARAMETER :: filename = 'TestLinks.h5' INTEGER :: cset ! Indicates the character set used for the link’s name. @@ -789,9 +789,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! WRITE(*,*) "moving and copying links preserves their properties (w/new group format)" - !/* Create a file creation property list with creation order stored for links + ! Create a file creation property list with creation order stored for links ! * in the root group - ! */ + ! CALL H5Pcreate_f(H5P_FILE_CREATE_F, fcpl_id, error) CALL check("H5Pcreate_f",error, total_error) @@ -807,26 +807,26 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pget_link_creation_order_f",error, total_error) CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error) - !/* Create file */ - !/* (with creation order tracking for the root group) */ + ! Create file + ! (with creation order tracking for the root group) CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file_id, error, fcpl_id, fapl_id) CALL check("h5fcreate_f",error,total_error) - !/* Create a link creation property list with the UTF-8 character encoding */ + ! Create a link creation property list with the UTF-8 character encoding CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error) CALL check("H5Pcreate_f",error, total_error) CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("H5Pset_char_encoding_f",error, total_error) - !/* Create a group with that lcpl */ + ! Create a group with that lcpl CALL H5Gcreate_f(file_id, "group", group_id, error,lcpl_id=lcpl_id, gcpl_id=H5P_DEFAULT_F, gapl_id=H5P_DEFAULT_F) CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) - ! /* Get the group's link's information */ + ! Get the group's link's information CALL H5Lget_info_f(file_id, "group", & cset, corder, f_corder_valid, link_type, address, val_size, & error, H5P_DEFAULT_F) @@ -842,18 +842,18 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! old_modification_time = oinfo.mtime; -! /* If this test happens too quickly, the times will all be the same. Make sure the time changes. */ +! If this test happens too quickly, the times will all be the same. Make sure the time changes. ! curr_time = HDtime(NULL); ! while(HDtime(NULL) <= curr_time) ! ; -! /* Close the file and reopen it */ +! Close the file and reopen it CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) !!$ if((file_id = H5Fopen(filename, H5F_ACC_RDWR, fapl_id)) < 0) TEST_ERROR !!$ -!!$ /* Get the link's character set & modification time . They should be unchanged */ +!!$ Get the link's character set & modification time . They should be unchanged !!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -861,7 +861,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder_valid != TRUE) TEST_ERROR !!$ if(old_corder != linfo.corder) TEST_ERROR !!$ -!!$ /* Create a new link to the group. It should have a different creation order value but the same modification time */ +!!$ Create a new link to the group. It should have a different creation order value but the same modification time !!$ if(H5Lcreate_hard(file_id, "group", file_id, "group2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -871,10 +871,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder != 1) TEST_ERROR !!$ if(linfo.cset != H5T_CSET_ASCII) TEST_ERROR !!$ -!!$ /* Copy the first link to a UTF-8 name. +!!$ Copy the first link to a UTF-8 name. !!$ * Its creation order value should be different, but modification time !!$ * should not change. -!!$ */ +!!$ !!$ if(H5Lcopy(file_id, "group", file_id, "group_copied", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group_copied", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -882,10 +882,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder_valid != TRUE) TEST_ERROR !!$ if(linfo.corder != 2) TEST_ERROR !!$ -!!$ /* Check that its character encoding is UTF-8 */ +!!$ Check that its character encoding is UTF-8 !!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR !!$ -!!$ /* Move the link with the default property list. */ +!!$ Move the link with the default property list. !!$ if(H5Lmove(file_id, "group_copied", file_id, "group_copied2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group_copied2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -893,10 +893,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder_valid != TRUE) TEST_ERROR !!$ if(linfo.corder != 3) TEST_ERROR !!$ -!!$ /* Check that its character encoding is not UTF-8 */ +!!$ Check that its character encoding is not UTF-8 !!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR !!$ -!!$ /* Check that the original link is unchanged */ +!!$ Check that the original link is unchanged !!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR !!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR @@ -904,9 +904,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(old_corder != linfo.corder) TEST_ERROR !!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR !!$ -!!$ /* Move the first link to a UTF-8 name. +!!$ Move the first link to a UTF-8 name. !!$ * Its creation order value will change, but modification time should not -!!$ * change. */ +!!$ * change. !!$ if(H5Lmove(file_id, "group", file_id, "group_moved", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group_moved", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -914,10 +914,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder_valid != TRUE) TEST_ERROR !!$ if(linfo.corder != 4) TEST_ERROR !!$ -!!$ /* Check that its character encoding is UTF-8 */ +!!$ Check that its character encoding is UTF-8 !!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR !!$ -!!$ /* Move the link again using the default property list. */ +!!$ Move the link again using the default property list. !!$ if(H5Lmove(file_id, "group_moved", file_id, "group_moved_again", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(H5Oget_info_by_name(file_id, "group_moved_again", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR !!$ if(old_modification_time != oinfo.mtime) TEST_ERROR @@ -925,10 +925,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ if(linfo.corder_valid != TRUE) TEST_ERROR !!$ if(linfo.corder != 5) TEST_ERROR !!$ -!!$ /* Check that its character encoding is not UTF-8 */ +!!$ Check that its character encoding is not UTF-8 !!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR - ! /* Close open IDs */ + ! Close open IDs CALL H5Pclose_f(fcpl_id, error) CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(lcpl_id, error) @@ -938,7 +938,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) END SUBROUTINE test_move_preserves -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: lifecycle ! * ! * Purpose: Test that adding links to a group follow proper "lifecycle" @@ -953,7 +953,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Monday, October 17, 2005 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE lifecycle(cleanup, fapl2, total_error) @@ -967,14 +967,14 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) INTEGER, PARAMETER :: NAME_BUF_SIZE =7 - INTEGER(HID_T) :: fid !/* File ID */ - INTEGER(HID_T) :: gid !/* Group ID */ - INTEGER(HID_T) :: gcpl !/* Group creation property list ID */ - INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */ - INTEGER :: max_compact !/* Maximum # of links to store in group compactly */ - INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */ - INTEGER :: est_num_entries !/* Estimated # of entries in group */ - INTEGER :: est_name_len !/* Estimated length of entry name */ + INTEGER(HID_T) :: fid ! File ID + INTEGER(HID_T) :: gid ! Group ID + INTEGER(HID_T) :: gcpl ! Group creation property list ID + INTEGER(size_t) :: lheap_size_hint ! Local heap size hint + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + INTEGER :: est_num_entries ! Estimated # of entries in group + INTEGER :: est_name_len ! Estimated length of entry name CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5' INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256 INTEGER :: LIFECYCLE_MAX_COMPACT = 4 @@ -991,29 +991,29 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) ! WRITE(*,*) 'group lifecycle' - ! /* Create file */ + ! Create file CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl2) CALL check("H5Fcreate_f",error,total_error) - !/* Close file */ + ! Close file CALL H5Fclose_f(fid,error) CALL check("H5Fclose_f",error,total_error) - ! /* Get size of file as empty */ + ! Get size of file as empty ! if((empty_size = h5_get_file_size(filename)) < 0) TEST_ERROR - ! /* Re-open file */ + ! Re-open file CALL H5Fopen_f(filename, H5F_ACC_RDWR_F, fid, error,access_prp=fapl2) CALL check("H5Fopen_f",error,total_error) - ! /* Set up group creation property list */ + ! Set up group creation property list CALL H5Pcreate_f(H5P_GROUP_CREATE_F,gcpl,error) CALL check("H5Pcreate_f",error,total_error) - ! /* Query default group creation property settings */ + ! Query default group creation property settings CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error) CALL check("H5Pget_local_heap_size_hint_f",error,total_error) CALL verify("H5Pget_local_heap_size_hint_f", INT(lheap_size_hint),0,total_error) @@ -1030,7 +1030,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL verify("H5Pget_est_link_info_f", est_name_len, H5G_CRT_GINFO_EST_NAME_LEN,total_error) - !/* Set GCPL parameters */ + ! Set GCPL parameters CALL H5Pset_local_heap_size_hint_f(gcpl, LIFECYCLE_LOCAL_HEAP_SIZE_HINT, error) CALL check("H5Pset_local_heap_size_hint_f", error, total_error) @@ -1039,12 +1039,12 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Pset_est_link_info_f(gcpl, LIFECYCLE_EST_NUM_ENTRIES, LIFECYCLE_EST_NAME_LEN, error) CALL check("H5Pset_est_link_info_f", error, total_error) - ! /* Create group for testing lifecycle */ + ! Create group for testing lifecycle CALL H5Gcreate_f(fid, LIFECYCLE_TOP_GROUP, gid, error, gcpl_id=gcpl) CALL check("H5Gcreate_f", error, total_error) - ! /* Query group creation property settings */ + ! Query group creation property settings CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error) CALL check("H5Pget_local_heap_size_hint_f",error,total_error) @@ -1062,20 +1062,20 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) - !/* Close top group */ + ! Close top group CALL H5Gclose_f(gid, error) CALL check("H5Gclose_f", error, total_error) - !/* Unlink top group */ + ! Unlink top group CALL H5Ldelete_f(fid, LIFECYCLE_TOP_GROUP, error) CALL check("H5Ldelete_f", error, total_error) - ! /* Close GCPL */ + ! Close GCPL CALL H5Pclose_f(gcpl, error) CALL check("H5Pclose_f", error, total_error) - ! /* Close file */ + ! Close file CALL H5Fclose_f(fid,error) CALL check("H5Fclose_f",error,total_error) @@ -1084,7 +1084,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) END SUBROUTINE lifecycle -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: cklinks ! * ! * Purpose: Open the file created in the first step and check that the @@ -1100,7 +1100,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) ! * Modifications: Modified original C code ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE cklinks(fapl, total_error) @@ -1124,25 +1124,25 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) LOGICAL :: Lexists - ! /* Open the file */ + ! Open the file CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, error,access_prp=fapl) CALL check("H5Fopen_f",error,total_error) - ! /* Hard link */ + ! Hard link !!$ IF(H5Oget_info_by_name(file, "d1", &oinfo1, H5P_DEFAULT) < 0) FAIL_STACK_ERROR !!$ IF(H5Oget_info_by_name(file, "grp1/hard", &oinfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR !!$ IF(H5O_TYPE_DATASET != oinfo2.type) { !!$ H5_FAILED(); !!$ printf(" %d: Unexpected object type should have been a dataset\n", __LINE__); !!$ TEST_ERROR -!!$ } /* end if */ +!!$ } end if !!$ if(H5F_addr_ne(oinfo1.addr, oinfo2.addr)) { !!$ H5_FAILED(); !!$ puts(" Hard link test failed. Link seems not to point to the "); !!$ puts(" expected file location."); !!$ TEST_ERROR -!!$ } /* end if */ +!!$ } end if CALL H5Lexists_f(file,"d1",Lexists, error) @@ -1151,14 +1151,14 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Lexists_f(file,"grp1/hard",Lexists, error) CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error) - ! /* Cleanup */ + ! Cleanup CALL H5Fclose_f(file,error) CALL check("H5Fclose_f",error,total_error) END SUBROUTINE cklinks -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: delete_by_idx ! * ! * Purpose: Create a group with creation order indices and test deleting @@ -1173,7 +1173,7 @@ END SUBROUTINE cklinks ! * March 3, 2008 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE delete_by_idx(cleanup, fapl, total_error) USE HDF5 ! This module contains all necessary modules @@ -1183,18 +1183,18 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl - INTEGER(HID_T) :: file_id ! /* File ID */ - INTEGER(HID_T) :: group_id ! /* Group ID */ - INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ + INTEGER(HID_T) :: file_id ! File ID + INTEGER(HID_T) :: group_id ! Group ID + INTEGER(HID_T) :: gcpl_id ! Group creation property list ID - INTEGER :: idx_type ! /* Type of index to operate on */ + INTEGER :: idx_type ! Type of index to operate on LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) - ! /* Use index on creation order values */ - INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ - INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ + ! Use index on creation order values + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" - CHARACTER(LEN=7) :: objname ! /* Object name */ - CHARACTER(LEN=8) :: filename = 'file0.h5' ! /* File name */ + CHARACTER(LEN=7) :: objname ! Object name + CHARACTER(LEN=8) :: filename = 'file0.h5' ! File name CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute @@ -1204,11 +1204,11 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) INTEGER :: link_type INTEGER(HADDR_T) :: address - INTEGER :: u ! /* Local index variable */ + INTEGER :: u ! Local index variable INTEGER :: Input1, i INTEGER(HID_T) :: group_id2 INTEGER(HID_T) :: grp - INTEGER :: iorder ! /* Order within in the index */ + INTEGER :: iorder ! Order within in the index CHARACTER(LEN=2) :: chr2 INTEGER :: error INTEGER :: id_type @@ -1226,13 +1226,13 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) fix_filename2(i:i) = " " ENDDO - ! /* Loop over operating on different indices on link fields */ + ! Loop over operating on different indices on link fields DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F - ! /* Loop over operating in different orders */ + ! Loop over operating in different orders DO iorder = H5_ITER_INC_F, H5_ITER_DEC_F - ! /* Loop over using index for creation order value */ + ! Loop over using index for creation order value DO i = 1, 2 - ! /* Print appropriate test message */ + ! Print appropriate test message !!$ IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN !!$ IF(iorder == H5_ITER_INC_F)THEN !!$ IF(use_index(i))THEN @@ -1263,15 +1263,15 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) !!$ ENDIF !!$ ENDIF - ! /* Create file */ + ! Create file CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl) CALL check("delete_by_idx.H5Fcreate_f", error, total_error) - ! /* Create group creation property list */ + ! Create group creation property list CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) CALL check("delete_by_idx.H5Pcreate_f", error, total_error) - ! /* Set creation order tracking & indexing on group */ + ! Set creation order tracking & indexing on group IF(use_index(i))THEN Input1 = H5P_CRT_ORDER_INDEXED_F ELSE @@ -1281,54 +1281,54 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) CALL check("delete_by_idx.H5Pset_link_creation_order_f", error, total_error) - ! /* Create group with creation order tracking on */ + ! Create group with creation order tracking on CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id) CALL check("delete_by_idx.H5Gcreate_f", error, total_error) - ! /* Query the group creation properties */ + ! Query the group creation properties CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error) CALL check("delete_by_idx.H5Pget_link_phase_change_f", error, total_error) - ! /* Delete links from one end */ + ! Delete links from one end - ! /* Check for deletion on empty group */ + ! Check for deletion on empty group CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error) CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) - ! /* Create several links, up to limit of compact form */ + ! Create several links, up to limit of compact form DO u = 0, max_compact-1 - ! /* Make name for link */ + ! Make name for link WRITE(chr2,'(I2.2)') u objname = 'fill '//chr2 - ! /* Create hard link, with group object */ + ! Create hard link, with group object CALL H5Gcreate_f(group_id, objname, group_id2, error) CALL check("delete_by_idx.H5Gcreate_f", error, total_error) CALL H5Gclose_f(group_id2, error) CALL check("delete_by_idx.H5Gclose_f", error, total_error) - ! /* Verify link information for new link */ + ! Verify link information for new link CALL link_info_by_idx_check(group_id, objname, u, & .TRUE., use_index(i), total_error) ENDDO - ! /* Verify state of group (compact) */ + ! Verify state of group (compact) ! IF(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR - ! /* Check for out of bound deletion */ + ! Check for out of bound deletion htmp =9 !EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error) CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error) CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) - ! /* Delete links from compact group */ + ! Delete links from compact group DO u = 0, (max_compact - 1) -1 - ! /* Delete first link in appropriate order */ + ! Delete first link in appropriate order CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error) CALL check("H5Ldelete_by_idx_f", error, total_error) - ! /* Verify the link information for first link in appropriate order */ + ! Verify the link information for first link in appropriate order ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), & @@ -1358,7 +1358,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) - ! /* Verify the name for first link in appropriate order */ + ! Verify the name for first link in appropriate order ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); !!$ size_tmp = 20 !!$ CALL H5Lget_name_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), size_tmp, tmpname, error) @@ -1374,15 +1374,15 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) !!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error) ENDDO - ! /* Close the group */ + ! Close the group CALL H5Gclose_f(group_id, error) CALL check("delete_by_idx.H5Gclose_f", error, total_error) - !/* Close the group creation property list */ + ! Close the group creation property list CALL H5Pclose_f(gcpl_id, error) CALL check("delete_by_idx.H5Gclose_f", error, total_error) - !/* Close the file */ + ! Close the file CALL H5Fclose_f(file_id, error) CALL check("delete_by_idx.H5Gclose_f", error, total_error) @@ -1398,7 +1398,7 @@ END SUBROUTINE delete_by_idx -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: link_info_by_idx_check ! * ! * Purpose: Support routine for link_info_by_idx, to verify the link @@ -1414,7 +1414,7 @@ END SUBROUTINE delete_by_idx ! * Tuesday, November 7, 2006 ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & hard_link, use_index, total_error) @@ -1436,35 +1436,35 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & INTEGER(HADDR_T) :: address INTEGER(SIZE_T) :: val_size ! Indicates the size, in the number of characters, of the attribute - CHARACTER(LEN=7) :: tmpname !/* Temporary link name */ - CHARACTER(LEN=3) :: tmpname_small !/* to small temporary link name */ - CHARACTER(LEN=10) :: tmpname_big !/* to big temporary link name */ + CHARACTER(LEN=7) :: tmpname ! Temporary link name + CHARACTER(LEN=3) :: tmpname_small ! to small temporary link name + CHARACTER(LEN=10) :: tmpname_big ! to big temporary link name - CHARACTER(LEN=7) :: valname !/* Link value name */ + CHARACTER(LEN=7) :: valname ! Link value name CHARACTER(LEN=2) :: chr2 INTEGER(SIZE_T) :: size_tmp INTEGER :: error - ! /* Make link value for increasing/native order queries */ + ! Make link value for increasing/native order queries WRITE(chr2,'(I2.2)') n valname = 'valn.'//chr2 - ! /* Verify the link information for first link, in increasing creation order */ + ! Verify the link information for first link, in increasing creation order ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), & link_type, f_corder_valid, corder, cset, address, val_size, error) CALL check("H5Lget_info_by_idx_f", error, total_error) CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error) - ! /* Verify the link information for new link, in increasing creation order */ + ! Verify the link information for new link, in increasing creation order ! HDmemset(&linfo, 0, sizeof(linfo)); CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), & link_type, f_corder_valid, corder, cset, address, val_size, error) CALL check("H5Lget_info_by_idx_f", error, total_error) CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error) - ! /* Verify value for new soft link, in increasing creation order */ + ! Verify value for new soft link, in increasing creation order !!$ IF(hard_link)THEN !!$ ! HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); !!$ @@ -1474,7 +1474,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & !!$! IF(HDstrcmp(valname, tmpval)) TEST_ERROR !!$ ENDIF - ! /* Verify the name for new link, in increasing creation order */ + ! Verify the name for new link, in increasing creation order ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); ! The actual size of tmpname should be 7 @@ -1503,7 +1503,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & END SUBROUTINE link_info_by_idx_check -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: test_lcpl ! * ! * Purpose: Tests Link Creation Property Lists @@ -1518,7 +1518,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE test_lcpl(cleanup, fapl, total_error) @@ -1565,35 +1565,35 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! WRITE(*,*) "link creation property lists (w/new group format)" - !/* Actually, intermediate group creation is tested elsewhere (tmisc). - ! * Here we only need to test the character encoding property */ + ! Actually, intermediate group creation is tested elsewhere (tmisc). + ! * Here we only need to test the character encoding property - !/* Create file */ + ! Create file ! h5_fixname(FILENAME[0], fapl, filename, sizeof filename); CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("H5Fcreate_f", error, total_error) - ! /* Create and link a group with the default LCPL */ + ! Create and link a group with the default LCPL CALL H5Gcreate_f(file_id, "/group", group_id, error) CALL check("H5Gcreate_f", error, total_error) - ! /* Check that its character encoding is the default */ + ! Check that its character encoding is the default CALL H5Lget_info_f(file_id, "group", & cset, corder, f_corder_valid, link_type, address, val_size, & error, H5P_DEFAULT_F) -!/* File-wide default character encoding can not yet be set via the file -! * creation property list and is always ASCII. */ +! File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- CALL VERIFY("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) - ! /* Create and commit a datatype with the default LCPL */ + ! Create and commit a datatype with the default LCPL CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) CALL check("h5tcopy_f",error,total_error) CALL h5tcommit_f(file_id, "/type", type_id, error) @@ -1602,19 +1602,19 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("h5tclose_f", error, total_error) - ! /* Check that its character encoding is the default */ + ! Check that its character encoding is the default CALL H5Lget_info_f(file_id, "type", & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("h5tclose_f", error, total_error) -!/* File-wide default character encoding can not yet be set via the file -! * creation property list and is always ASCII. */ +! File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) - !/* Create a dataspace */ + ! Create a dataspace CALL h5screate_simple_f(2, dims, space_id, error) CALL check("h5screate_simple_f",error,total_error) CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) @@ -1624,7 +1624,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) CALL h5pset_chunk_f(crp_list, 2, dims, error) - ! /* Create a dataset using the default LCPL */ + ! Create a dataset using the default LCPL CALL h5dcreate_f(file_id, "/dataset", H5T_NATIVE_INTEGER, space_id, dset_id, error, crp_list) CALL check("h5dcreate_f", error, total_error) @@ -1636,10 +1636,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL H5Dopen_f(file_id, "/dataset", dset_id, error) CALL check("h5dopen_f", error, total_error) - ! /* Extend the dataset */ + ! Extend the dataset CALL H5Dset_extent_f(dset_id, extend_dim, error) CALL check("H5Dset_extent_f", error, total_error) - ! /* Verify the dataspaces */ + ! Verify the dataspaces ! !Get dataset's dataspace handle. ! @@ -1658,37 +1658,37 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error) ENDDO - ! /* close data set */ + ! close data set CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) - ! /* Check that its character encoding is the default */ + ! Check that its character encoding is the default CALL H5Lget_info_f(file_id, "dataset", & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("H5Lget_info_f", error, total_error) -!/* File-wide default character encoding can not yet be set via the file -! * creation property list and is always ASCII. */ +! File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. !#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- CALL verify("h5tclose_f",cset, H5T_CSET_ASCII_F,total_error) - !/* Create a link creation property list with the UTF-8 character encoding */ + ! Create a link creation property list with the UTF-8 character encoding CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error) CALL check("h5Pcreate_f",error,total_error) CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("H5Pset_char_encoding_f",error, total_error) - ! /* Create and link a group with the new LCPL */ + ! Create and link a group with the new LCPL CALL H5Gcreate_f(file_id, "/group2", group_id, error,lcpl_id=lcpl_id) CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) - !/* Check that its character encoding is UTF-8 */ + ! Check that its character encoding is UTF-8 CALL H5Lget_info_f(file_id, "group2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) @@ -1696,7 +1696,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) - ! /* Create and commit a datatype with the new LCPL */ + ! Create and commit a datatype with the new LCPL CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) CALL check("h5tcopy_f",error,total_error) @@ -1706,14 +1706,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("h5tclose_f", error, total_error) - !/* Check that its character encoding is UTF-8 */ + ! Check that its character encoding is UTF-8 CALL H5Lget_info_f(file_id, "type2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("H5Lget_info_f", error, total_error) CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) - ! /* Create a dataset using the new LCPL */ + ! Create a dataset using the new LCPL CALL h5dcreate_f(file_id, "/dataset2", H5T_NATIVE_INTEGER, space_id, dset_id, error,lcpl_id=lcpl_id) CALL check("h5dcreate_f", error, total_error) @@ -1724,14 +1724,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("H5Pget_char_encoding_f", error, total_error) CALL VERIFY("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) - ! /* Check that its character encoding is UTF-8 */ + ! Check that its character encoding is UTF-8 CALL H5Lget_info_f(file_id, "dataset2", & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("H5Lget_info_f", error, total_error) CALL verify("H5Lget_info_f2",cset, H5T_CSET_UTF8_F,total_error) - ! /* Create a new link to the dataset with a different character encoding. */ + ! Create a new link to the dataset with a different character encoding. CALL H5Pclose_f(lcpl_id, error) CALL check("H5Pclose_f", error, total_error) @@ -1746,14 +1746,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("H5Lexists",error, total_error) CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error) - ! /* Check that its character encoding is ASCII */ + ! Check that its character encoding is ASCII CALL H5Lget_info_f(file_id, "/dataset2_link", & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("H5Lget_info_f", error, total_error) CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) - ! /* Check that the first link's encoding hasn't changed */ + ! Check that the first link's encoding hasn't changed CALL H5Lget_info_f(file_id, "/dataset2", & cset, corder, f_corder_valid, link_type, address, val_size, & @@ -1762,8 +1762,8 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f3",cset, H5T_CSET_UTF8_F,total_error) - !/* Make sure that LCPLs work properly for other API calls: */ - !/* H5Lcreate_soft */ + ! Make sure that LCPLs work properly for other API calls: + ! H5Lcreate_soft CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("H5Pset_char_encoding_f",error, total_error) @@ -1777,7 +1777,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) - ! /* H5Lmove */ + ! H5Lmove CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error) CALL check("H5Pset_char_encoding_f",error, total_error) @@ -1791,7 +1791,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) - ! /* H5Lcopy */ + ! H5Lcopy CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("H5Pset_char_encoding_f",error, total_error) @@ -1805,7 +1805,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) - ! /* H5Lcreate_external */ + ! H5Lcreate_external CALL H5Lcreate_external_f("filename", "path", file_id, "extlink", error, lcpl_id) CALL check("H5Lcreate_external_f", error, total_error) @@ -1817,7 +1817,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) - ! /* Close open IDs */ + ! Close open IDs CALL H5Pclose_f(lcpl_id, error) CALL check("H5Pclose_f", error, total_error) @@ -1849,22 +1849,22 @@ SUBROUTINE objcopy(fapl, total_error) flag = H5O_COPY_SHALLOW_HIERARCHY_F -!/* Copy the file access property list */ +! Copy the file access property list CALL H5Pcopy_f(fapl, fapl2, error) CALL check("H5Pcopy_f", error, total_error) -!/* Set the "use the latest version of the format" bounds for creating objects in the file */ +! Set the "use the latest version of the format" bounds for creating objects in the file CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) - ! /* create property to pass copy options */ + ! create property to pass copy options CALL h5pcreate_f(H5P_OBJECT_COPY_F, pid, error) CALL check("h5pcreate_f",error, total_error) - ! /* set options for object copy */ + ! set options for object copy CALL H5Pset_copy_object_f(pid, flag, error) CALL check("H5Pset_copy_object_f",error, total_error) - ! /* Verify object copy flags */ + ! Verify object copy flags CALL H5Pget_copy_object_f(pid, cpy_flags, error) CALL check("H5Pget_copy_object_f",error, total_error) CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error) @@ -1878,7 +1878,7 @@ SUBROUTINE objcopy(fapl, total_error) END SUBROUTINE objcopy -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: lapl_nlinks ! * ! * Purpose: Check that the maximum number of soft links can be adjusted @@ -1894,7 +1894,7 @@ END SUBROUTINE objcopy ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE lapl_nlinks( fapl, total_error) @@ -1907,30 +1907,30 @@ SUBROUTINE lapl_nlinks( fapl, total_error) INTEGER :: error - INTEGER(HID_T) :: fid = (-1) !/* File ID */ - INTEGER(HID_T) :: gid = (-1), gid2 = (-1) !/* Group IDs */ - INTEGER(HID_T) :: plist = (-1) ! /* lapl ID */ - INTEGER(HID_T) :: tid = (-1) ! /* Other IDs */ - INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! /* Other property lists */ + INTEGER(HID_T) :: fid = (-1) ! File ID + INTEGER(HID_T) :: gid = (-1), gid2 = (-1) ! Group IDs + INTEGER(HID_T) :: plist = (-1) ! lapl ID + INTEGER(HID_T) :: tid = (-1) ! Other IDs + INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! Other property lists - CHARACTER(LEN=7) :: objname ! /* Object name */ - INTEGER(size_t) :: name_len ! /* Length of object name */ + CHARACTER(LEN=7) :: objname ! Object name + INTEGER(size_t) :: name_len ! Length of object name CHARACTER(LEN=12) :: filename = 'TestLinks.h5' - INTEGER(size_t) :: nlinks ! /* nlinks for H5Pset_nlinks */ + INTEGER(size_t) :: nlinks ! nlinks for H5Pset_nlinks INTEGER(size_t) :: buf_size = 7 ! WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)" - ! /* Create file */ + ! Create file CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl) CALL check(" lapl_nlinks.h5fcreate_f",error,total_error) - ! /* Create group with short name in file (used as target for links) */ + ! Create group with short name in file (used as target for links) CALL H5Gcreate_f(fid, "final", gid, error) CALL check(" lapl_nlinks.H5Gcreate_f", error, total_error) - !/* Create chain of soft links to existing object (limited) */ + ! Create chain of soft links to existing object (limited) CALL H5Lcreate_soft_f("final", fid, "soft1", error) CALL H5Lcreate_soft_f("soft1", fid, "soft2", error) CALL H5Lcreate_soft_f("soft2", fid, "soft3", error) @@ -1949,98 +1949,98 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL H5Lcreate_soft_f("soft15", fid, "soft16", error) CALL H5Lcreate_soft_f("soft16", fid, "soft17", error) - !/* Close objects */ + ! Close objects CALL H5Gclose_f(gid, error) CALL check("h5gclose_f",error,total_error) CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - !/* Open file */ + ! Open file CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL check("h5open_f",error,total_error) - !/* Create LAPL with higher-than-usual nlinks value */ - !/* Create a non-default lapl with udata set to point to the first group */ + ! Create LAPL with higher-than-usual nlinks value + ! Create a non-default lapl with udata set to point to the first group CALL H5Pcreate_f(H5P_LINK_ACCESS_F,plist,error) CALL check("h5Pcreate_f",error,total_error) nlinks = 20 CALL H5Pset_nlinks_f(plist, nlinks, error) CALL check("H5Pset_nlinks_f",error,total_error) - !/* Ensure that nlinks was set successfully */ + ! Ensure that nlinks was set successfully nlinks = 0 CALL H5Pget_nlinks_f(plist, nlinks, error) CALL check("H5Pset_nlinks_f",error,total_error) CALL VERIFY("H5Pset_nlinks_f",INT(nlinks), 20, total_error) - !/* Open object through what is normally too many soft links using - ! * new property list */ + ! Open object through what is normally too many soft links using + ! * new property list CALL H5Oopen_f(fid,"soft17",gid,error,plist) CALL check("H5Oopen_f",error,total_error) - !/* Check name */ + ! Check name CALL h5iget_name_f(gid, objname, buf_size, name_len, error) CALL check("h5iget_name_f",error,total_error) CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft17", total_error) - !/* Create group using soft link */ + ! Create group using soft link CALL H5Gcreate_f(gid, "new_soft", gid2, error) CALL check("H5Gcreate_f", error, total_error) - ! /* Close groups */ + ! Close groups CALL H5Gclose_f(gid2, error) CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(gid, error) CALL check("H5Gclose_f", error, total_error) - !/* Set nlinks to a smaller number */ + ! Set nlinks to a smaller number nlinks = 4 CALL H5Pset_nlinks_f(plist, nlinks, error) CALL check("H5Pset_nlinks_f", error, total_error) - !/* Ensure that nlinks was set successfully */ + ! Ensure that nlinks was set successfully nlinks = 0 CALL H5Pget_nlinks_f(plist, nlinks, error) CALL check("H5Pget_nlinks_f",error,total_error) CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error) - ! /* Try opening through what is now too many soft links */ + ! Try opening through what is now too many soft links CALL H5Oopen_f(fid,"soft5",gid,error,plist) CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail - ! /* Open object through lesser soft link */ + ! Open object through lesser soft link CALL H5Oopen_f(fid,"soft4",gid,error,plist) CALL check("H5Oopen_",error,total_error) - ! /* Check name */ + ! Check name CALL h5iget_name_f(gid, objname, buf_size, name_len, error) CALL check("h5iget_name_f",error,total_error) CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft4", total_error) - ! /* Test other functions that should use a LAPL */ + ! Test other functions that should use a LAPL nlinks = 20 CALL H5Pset_nlinks_f(plist, nlinks, error) CALL check("H5Pset_nlinks_f", error, total_error) - !/* Try copying and moving when both src and dst contain many soft links + ! Try copying and moving when both src and dst contain many soft links ! * using a non-default LAPL - ! */ + ! CALL H5Lcopy_f(fid, "soft17", fid, "soft17/newer_soft", error, H5P_DEFAULT_F, plist) CALL check("H5Lcopy_f",error,total_error) CALL H5Lmove_f(fid, "soft17/newer_soft", fid, "soft17/newest_soft", error, lapl_id=plist) CALL check("H5Lmove_f",error, total_error) - ! /* H5Olink */ + ! H5Olink CALL H5Olink_f(gid, fid, "soft17/link_to_group", error, H5P_DEFAULT_F, plist) CALL check("H5Olink_f", error, total_error) - ! /* H5Lcreate_hard and H5Lcreate_soft */ + ! H5Lcreate_hard and H5Lcreate_soft CALL H5Lcreate_hard_f(fid, "soft17", fid, "soft17/link2_to_group", error, H5P_DEFAULT_F, plist) CALL check("H5Lcreate_hard_f", error, total_error) @@ -2048,27 +2048,27 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL H5Lcreate_soft_f("/soft4", fid, "soft17/soft_link",error, H5P_DEFAULT_F, plist) CALL check("H5Lcreate_soft_f", error, total_error) - ! /* H5Ldelete */ + ! H5Ldelete CALL h5ldelete_f(fid, "soft17/soft_link", error, plist) CALL check("H5Ldelete_f", error, total_error) -!!$ /* H5Lget_val and H5Lget_info */ +!!$ H5Lget_val and H5Lget_info !!$ if(H5Lget_val(fid, "soft17", NULL, (size_t)0, plist) < 0) TEST_ERROR !!$ if(H5Lget_info(fid, "soft17", NULL, plist) < 0) TEST_ERROR !!$ - ! /* H5Lcreate_external and H5Lcreate_ud */ + ! H5Lcreate_external and H5Lcreate_ud CALL H5Lcreate_external_f("filename", "path", fid, "soft17/extlink", error, H5P_DEFAULT_F, plist) CALL check("H5Lcreate_external_f", error, total_error) !!$ if(H5Lregister(UD_rereg_class) < 0) TEST_ERROR !!$ if(H5Lcreate_ud(fid, "soft17/udlink", UD_HARD_TYPE, NULL, (size_t)0, H5P_DEFAULT, plist) < 0) TEST_ERROR !!$ - ! /* Close plist */ + ! Close plist CALL h5pclose_f(plist, error) CALL check("h5pclose_f", error, total_error) - ! /* Create a datatype and dataset as targets inside the group */ + ! Create a datatype and dataset as targets inside the group CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error) CALL check("h5tcopy_f",error,total_error) CALL h5tcommit_f(gid, "datatype", tid, error) @@ -2083,12 +2083,12 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ if((did = H5Dcreate2(gid, "dataset", H5T_NATIVE_INT, sid, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR !!$ if(H5Dclose(did) < 0) TEST_ERROR !!$ - !/* Close group */ + ! Close group CALL h5gclose_f(gid, error) CALL check("h5gclose_f",error,total_error) !!$ -!!$ /* Try to open the objects using too many symlinks with default *APLs */ +!!$ Try to open the objects using too many symlinks with default *APLs !!$ H5E_BEGIN_TRY { !!$ if((gid = H5Gopen2(fid, "soft17", H5P_DEFAULT)) >= 0) !!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.") @@ -2098,7 +2098,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.") !!$ } H5E_END_TRY !!$ - ! /* Create property lists with nlinks set */ + ! Create property lists with nlinks set CALL H5Pcreate_f(H5P_GROUP_ACCESS_F,gapl,error) CALL check("h5Pcreate_f",error,total_error) @@ -2116,9 +2116,9 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL H5Pset_nlinks_f(dapl, nlinks, error) CALL check("H5Pset_nlinks_f", error, total_error) - !/* We should now be able to use these property lists to open each kind + ! We should now be able to use these property lists to open each kind ! * of object. - ! */ + ! CALL H5Gopen_f(fid, "soft17", gid, error, gapl) CALL check("H5Gopen_f",error,total_error) @@ -2128,7 +2128,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ if((did = H5Dopen2(fid, "soft17/dataset", dapl)) < 0) TEST_ERROR - ! /* Close objects */ + ! Close objects CALL h5gclose_f(gid, error) CALL check("h5gclose_f",error,total_error) @@ -2137,7 +2137,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ if(H5Dclose(did) < 0) TEST_ERROR !!$ - ! /* Close plists */ + ! Close plists CALL h5pclose_f(gapl, error) CALL check("h5pclose_f", error, total_error) @@ -2146,11 +2146,11 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ if(H5Pclose(dapl) < 0) TEST_ERROR !!$ -!!$ /* Unregister UD hard link class */ +!!$ Unregister UD hard link class !!$ if(H5Lunregister(UD_HARD_TYPE) < 0) TEST_ERROR !!$ - ! /* Close file */ + ! Close file CALL H5Fclose_f(fid, error) CALL check("H5Fclose_f", error, total_error) diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90 index efc350e..efaf594 100644 --- a/fortran/test/tH5MISC_1_8.f90 +++ b/fortran/test/tH5MISC_1_8.f90 @@ -80,38 +80,36 @@ SUBROUTINE dtransform(cleanup, total_error) IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - END SUBROUTINE dtransform -!/**************************************************************** +!*************************************************************** !** !** test_genprop_basic_class(): Test basic generic property list code. !** Tests creating new generic classes. !** -!****************************************************************/ +!*************************************************************** -SUBROUTINE test_genprop_basic_class(cleanup, total_error) +SUBROUTINE test_genprop_basic_class(total_error) USE HDF5 ! This module contains all necessary modules USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - INTEGER(HID_T) :: cid1 !/* Generic Property class ID */ - INTEGER(HID_T) :: cid2 !/* Generic Property class ID */ + INTEGER(HID_T) :: cid1 ! Generic Property class ID + INTEGER(HID_T) :: cid2 ! Generic Property class ID CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" - CHARACTER(LEN=7) :: name ! /* Name of class */ - CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */ - CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/ + CHARACTER(LEN=7) :: name ! Name of class + CHARACTER(LEN=10) :: name_big ! Name of class bigger buffer + CHARACTER(LEN=4) :: name_small ! Name of class smaller buffer INTEGER :: error INTEGER :: size LOGICAL :: flag - !/* Output message about test being performed */ + ! Output message about test being performed !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality" @@ -121,11 +119,11 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error) CALL H5Pget_class_name_f(cid1, name, size, error) CALL VERIFY("H5Pget_class_name", error, -1, error) - ! /* Create a new generic class, derived from the root of the class hierarchy */ + ! Create a new generic class, derived from the root of the class hierarchy CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error) CALL check("H5Pcreate_class", error, total_error) - ! /* Check class name */ + ! Check class name CALL H5Pget_class_name_f(cid1, name, size, error) CALL check("H5Pget_class_name", error, total_error) CALL VERIFY("H5Pget_class_name", size,7,error) @@ -135,7 +133,7 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error) total_error = total_error + 1 ENDIF - ! /* Check class name smaller buffer*/ + ! Check class name smaller buffer CALL H5Pget_class_name_f(cid1, name_small, size, error) CALL check("H5Pget_class_name", error, total_error) CALL VERIFY("H5Pget_class_name", size,7,error) @@ -145,7 +143,7 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error) total_error = total_error + 1 ENDIF - ! /* Check class name bigger buffer*/ + ! Check class name bigger buffer CALL H5Pget_class_name_f(cid1, name_big, size, error) CALL check("H5Pget_class_name", error, total_error) CALL VERIFY("H5Pget_class_name", size,7,error) @@ -155,56 +153,55 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error) total_error = total_error + 1 ENDIF - ! /* Check class parent */ + ! Check class parent CALL H5Pget_class_parent_f(cid1, cid2, error) CALL check("H5Pget_class_parent_f", error, total_error) - ! /* Verify class parent correct */ + ! Verify class parent correct CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error) CALL check("H5Pequal_f", error, total_error) CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error) - ! /* Make certain false postives aren't being returned */ + ! Make certain false postives aren't being returned CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error) CALL check("H5Pequal_f", error, total_error) CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error) - !/* Close parent class */ + ! Close parent class CALL H5Pclose_class_f(cid2, error) CALL check("H5Pclose_class_f", error, total_error) - !/* Close class */ + ! Close class CALL H5Pclose_class_f(cid1, error) CALL check("H5Pclose_class_f", error, total_error) END SUBROUTINE test_genprop_basic_class -SUBROUTINE test_h5s_encode(cleanup, total_error) +SUBROUTINE test_h5s_encode(total_error) -!/**************************************************************** +!*************************************************************** !** !** test_h5s_encode(): Test H5S (dataspace) encoding and decoding. !** -!****************************************************************/ +!*************************************************************** USE HDF5 ! This module contains all necessary modules USE TH5_MISC IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */ + INTEGER(hid_t) :: sid1, sid3! Dataspace ID INTEGER(hid_t) :: decoded_sid1, decoded_sid3 - INTEGER :: rank !/* LOGICAL rank of dataspace */ + INTEGER :: rank ! LOGICAL rank of dataspace INTEGER(size_t) :: sbuf_size=0, scalar_size=0 ! Make sure the size is large CHARACTER(LEN=288) :: sbuf CHARACTER(LEN=288) :: scalar_buf - INTEGER(hsize_t) :: n ! /* Number of dataspace elements */ + INTEGER(hsize_t) :: n ! Number of dataspace elements INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/) INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/) @@ -221,10 +218,10 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) INTEGER :: SPACE1_RANK = 3 INTEGER :: error - !/*------------------------------------------------------------------------- + !------------------------------------------------------------------------- ! * Test encoding and decoding of simple dataspace and hyperslab selection. ! *------------------------------------------------------------------------- - ! */ + ! CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) CALL check("H5Screate_simple", error, total_error) @@ -234,14 +231,14 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Encode simple data space in a buffer */ + ! Encode simple data space in a buffer ! First find the buffer size CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) CALL check("H5Sencode", error, total_error) - ! /* Try decoding bogus buffer */ + ! Try decoding bogus buffer CALL H5Sdecode_f(sbuf, decoded_sid1, error) CALL VERIFY("H5Sdecode", error, -1, total_error) @@ -249,12 +246,12 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) CALL check("H5Sencode", error, total_error) - ! /* Decode from the dataspace buffer and return an object handle */ + ! Decode from the dataspace buffer and return an object handle CALL H5Sdecode_f(sbuf, decoded_sid1, error) CALL check("H5Sdecode", error, total_error) - ! /* Verify the decoded dataspace */ + ! Verify the decoded dataspace CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error) CALL check("h5sget_simple_extent_npoints_f", error, total_error) CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), & @@ -269,16 +266,16 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) CALL h5sclose_f(decoded_sid1, error) CALL check("h5sclose_f", error, total_error) - ! /*------------------------------------------------------------------------- + ! ------------------------------------------------------------------------- ! * Test encoding and decoding of scalar dataspace. ! *------------------------------------------------------------------------- - ! */ - ! /* Create scalar dataspace */ + ! + ! Create scalar dataspace CALL H5Screate_f(H5S_SCALAR_F, sid3, error) CALL check("H5Screate_f",error, total_error) - ! /* Encode scalar data space in a buffer */ + ! Encode scalar data space in a buffer ! First find the buffer size CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) @@ -290,19 +287,19 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) CALL check("H5Sencode_f", error, total_error) - ! /* Decode from the dataspace buffer and return an object handle */ + ! Decode from the dataspace buffer and return an object handle CALL H5Sdecode_f(scalar_buf, decoded_sid3, error) CALL check("H5Sdecode_f", error, total_error) - ! /* Verify extent type */ + ! Verify extent type CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error) CALL check("H5Sget_simple_extent_type_f", error, total_error) CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error) - ! /* Verify decoded dataspace */ + ! Verify decoded dataspace CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error) CALL check("h5sget_simple_extent_npoints_f", error, total_error) CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error) @@ -469,6 +466,9 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) CALL H5Fclose_f(file, error) CALL CHECK(" H5Fclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f("h5scaleoffset", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + END SUBROUTINE test_scaleoffset END MODULE TH5MISC_1_8 diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90 index 8672e3c..99d4c22 100644 --- a/fortran/test/tH5O.f90 +++ b/fortran/test/tH5O.f90 @@ -49,11 +49,11 @@ SUBROUTINE test_h5o(cleanup, total_error) END SUBROUTINE test_h5o -!/**************************************************************** +!*************************************************************** !** !** test_h5o_link: Test creating link to object !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_h5o_link(total_error) @@ -80,10 +80,10 @@ SUBROUTINE test_h5o_link(total_error) INTEGER, PARAMETER :: TRUE = 1 - LOGICAL :: committed ! /* Whether the named datatype is committed + LOGICAL :: committed ! Whether the named datatype is committed INTEGER :: i, j - INTEGER :: error ! /* Value returned from API calls + INTEGER :: error ! Value returned from API calls CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT" CHARACTER(LEN=16) :: NAME_DATATYPE_SIMPLE2="H5T_NATIVE_INT-2" diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90 index b7003b3..8e014f4 100644 --- a/fortran/test/tH5O_F03.f90 +++ b/fortran/test/tH5O_F03.f90 @@ -116,11 +116,11 @@ END MODULE visit_cb MODULE TH5O_F03 CONTAINS -!/**************************************************************** +!*************************************************************** !** !** test_h5o_refcount(): Test H5O refcounting functions. !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_h5o_refcount(total_error) diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 8b48be6..7dcc580 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -450,8 +450,6 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) INTEGER(size_t) rdcc_nelmts INTEGER(size_t) rdcc_nbytes REAL :: rdcc_w0 - LOGICAL :: differ - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index 945d0a5..56f9679 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -43,7 +43,7 @@ MODULE test_genprop_cls_cb1_mod USE ISO_C_BINDING IMPLICIT NONE - TYPE, BIND(C) :: cop_cb_struct_ ! /* Struct for iterations */ + TYPE, BIND(C) :: cop_cb_struct_ ! Struct for iterations INTEGER :: count INTEGER(HID_T) :: id END TYPE cop_cb_struct_ @@ -73,7 +73,7 @@ MODULE TH5P_F03 CONTAINS -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: test_create ! * ! * Purpose: Tests H5Pset_fill_value_f and H5Pget_fill_value_f @@ -88,7 +88,7 @@ CONTAINS ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE test_create(total_error) @@ -116,9 +116,9 @@ SUBROUTINE test_create(total_error) REAL :: rfill REAL(KIND=dp) :: dpfill - !/* + ! ! * Create a file. - ! */ + ! CALL h5fcreate_f(filename,H5F_ACC_TRUNC_F,file,error) CALL check("h5fcreate_f", error, total_error) @@ -131,7 +131,7 @@ SUBROUTINE test_create(total_error) CALL h5pset_chunk_f(dcpl, 5, ch_size, error) CALL check("h5pset_chunk_f",error, total_error) - ! /* Create a compound datatype */ + ! Create a compound datatype CALL h5tcreate_f(H5T_COMPOUND_F, H5_SIZEOF(fill_ctype), comp_type_id, error) CALL check("h5tcreate_f", error, total_error) h5off = H5OFFSETOF(C_LOC(fill_ctype), C_LOC(fill_ctype%a)) @@ -152,7 +152,7 @@ SUBROUTINE test_create(total_error) CALL H5Pset_fill_time_f(dcpl, H5D_FILL_TIME_ALLOC_F, error) CALL check("H5Pset_fill_time_f",error, total_error) - ! /* Compound datatype test */ + ! Compound datatype test f_ptr = C_LOC(fill_ctype) @@ -213,7 +213,7 @@ SUBROUTINE test_create(total_error) CALL h5fclose_f(file,error) CALL check("h5fclose_f", error, total_error) - ! /* Open the file and get the dataset fill value from each dataset */ + ! Open the file and get the dataset fill value from each dataset CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) CALL check("H5Pcreate_f",error, total_error) @@ -223,7 +223,7 @@ SUBROUTINE test_create(total_error) CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, file, error, fapl) CALL check("h5fopen_f", error, total_error) - !/* Compound datatype test */ + ! Compound datatype test CALL h5dopen_f(file, "dset9", dset9, error) CALL check("h5dopen_f", error, total_error) @@ -277,14 +277,13 @@ SUBROUTINE test_genprop_class_callback(total_error) INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: cid1 !/* Generic Property class ID */ - INTEGER(hid_t) :: lid1 !/* Generic Property list ID */ - INTEGER(hid_t) :: lid2 !/* 2nd Generic Property list ID */ - INTEGER(size_t) :: nprops !/* Number of properties in class */ + INTEGER(hid_t) :: cid1, cid2 ! Generic Property class ID + INTEGER(hid_t) :: lid1, lid2 ! Generic Property list ID + INTEGER(size_t) :: nprops ! Number of properties in class TYPE(cop_cb_struct_), TARGET :: crt_cb_struct, cls_cb_struct - - CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" + INTEGER :: CLASS1_NAME_SIZE = 7 ! length of class string + CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1", CLASS1_NAME_BUF TYPE(C_FUNPTR) :: f1, f5 TYPE(C_PTR) :: f2, f6 @@ -301,7 +300,8 @@ SUBROUTINE test_genprop_class_callback(total_error) INTEGER :: PROP3_DEF_VALUE = 10 INTEGER :: PROP4_DEF_VALUE = 10 - INTEGER :: error ! /* Generic RETURN value */ + INTEGER :: error ! Generic RETURN value + LOGICAL :: flag ! for tests f1 = C_FUNLOC(test_genprop_cls_cb1_f) f5 = C_FUNLOC(test_genprop_cls_cb1_f) @@ -309,79 +309,100 @@ SUBROUTINE test_genprop_class_callback(total_error) f2 = C_LOC(crt_cb_struct) f6 = C_LOC(cls_cb_struct) - !/* Create a new generic class, derived from the root of the class hierarchy */ - CALL h5pcreate_class_f(h5p_ROOT_F,CLASS1_NAME, cid1, error, f1, f2, c_null_funptr, c_null_ptr, f5, f6) + ! Create a new generic class, derived from the root of the class hierarchy + CALL h5pcreate_class_f(h5p_ROOT_F, CLASS1_NAME, cid1, error, f1, f2, c_null_funptr, c_null_ptr, f5, f6) CALL check("h5pcreate_class_f", error, total_error) - !/* Insert first property into class (with no callbacks) */ + ! Insert first property into class (with no callbacks) CALL h5pregister_f(cid1, PROP1_NAME, PROP1_SIZE, PROP1_DEF_VALUE, error) CALL check("h5pregister_f", error, total_error) - !/* Insert second property into class (with no callbacks) */ + ! Insert second property into class (with no callbacks) CALL h5pregister_f(cid1, PROP2_NAME, PROP2_SIZE, PROP2_DEF_VALUE, error) CALL check("h5pregister_f", error, total_error) - !/* Insert third property into class (with no callbacks) */ + ! Insert third property into class (with no callbacks) CALL h5pregister_f(cid1, PROP3_NAME, PROP3_SIZE, PROP3_DEF_VALUE, error) CALL check("h5pregister_f", error, total_error) - !/* Insert fourth property into class (with no callbacks) */ + ! Insert fourth property into class (with no callbacks) CALL h5pregister_f(cid1, PROP4_NAME, PROP4_SIZE, PROP4_DEF_VALUE, error) CALL check("h5pregister_f", error, total_error) - ! /* Check the number of properties in class */ + ! Check the number of properties in class CALL h5pget_nprops_f(cid1, nprops, error) CALL check("h5pget_nprops_f", error, total_error) CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error) - ! /* Initialize class callback structs */ + ! Initialize class callback structs crt_cb_struct%count = 0 crt_cb_struct%id = -1 cls_cb_struct%count = 0 cls_cb_struct%id = -1 - !/* Create a property list from the class */ + ! Create a property list from the class CALL h5pcreate_f(cid1, lid1, error) CALL check("h5pcreate_f", error, total_error) - !/* Verify that the creation callback occurred */ + ! Get the list's class + CALL H5Pget_class_f(lid1, cid2, error) + CALL check("H5Pget_class_f", error, total_error) + + ! Check that the list's class is correct + CALL H5Pequal_f(cid2, cid1, flag, error) + CALL check("H5Pequal_f", error, total_error) + CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error) + + ! Check the class name + CALL H5Pget_class_name_f(cid2, CLASS1_NAME_BUF, CLASS1_NAME_SIZE, error) + CALL check("H5Pget_class_name_f", error, total_error) + CALL verifystring("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',CLASS1_NAME_BUF, 'CLASS1_NAME=',CLASS1_NAME + total_error = total_error + 1 + ENDIF + ! Close class + CALL h5pclose_class_f(cid2, error) + CALL check("h5pclose_class_f", error, total_error) + + ! Verify that the creation callback occurred CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 1, total_error) - CALL VERIFY("h5pcreate_f", INT(crt_cb_struct%id), INT(lid1), total_error) + CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid1, total_error) - ! /* Check the number of properties in list */ + ! Check the number of properties in list CALL h5pget_nprops_f(lid1,nprops, error) CALL check("h5pget_nprops_f", error, total_error) CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error) - ! /* Create another property list from the class */ + ! Create another property list from the class CALL h5pcreate_f(cid1, lid2, error) CALL check("h5pcreate_f", error, total_error) - ! /* Verify that the creation callback occurred */ + ! Verify that the creation callback occurred CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 2, total_error) - CALL VERIFY("h5pcreate_f", INT(crt_cb_struct%id), INT(lid2), total_error) + CALL VERIFY_INTEGER_HID_T("h5pcreate_f", crt_cb_struct%id, lid2, total_error) - ! /* Check the number of properties in list */ + ! Check the number of properties in list CALL h5pget_nprops_f(lid2,nprops, error) CALL check("h5pget_nprops_f", error, total_error) CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error) - ! /* Close first list */ + ! Close first list CALL h5pclose_f(lid1, error); CALL check("h5pclose_f", error, total_error) - !/* Verify that the close callback occurred */ + ! Verify that the close callback occurred CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 1, total_error) - CALL VERIFY("h5pcreate_f", INT(cls_cb_struct%id), INT(lid1), total_error) + CALL VERIFY_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid1, total_error) - !/* Close second list */ + ! Close second list CALL h5pclose_f(lid2, error); CALL check("h5pclose_f", error, total_error) - !/* Verify that the close callback occurred */ + ! Verify that the close callback occurred CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 2, total_error) - CALL VERIFY("h5pcreate_f", INT(cls_cb_struct%id), INT(lid2), total_error) + CALL verify_INTEGER_HID_T("h5pcreate_f", cls_cb_struct%id, lid2, total_error) - !/* Close class */ + ! Close class CALL h5pclose_class_f(cid1, error) CALL check("h5pclose_class_f", error, total_error) diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 index ba68d62..7d07308 100644 --- a/fortran/test/tH5Sselect.f90 +++ b/fortran/test/tH5Sselect.f90 @@ -1027,13 +1027,13 @@ CONTAINS RETURN END SUBROUTINE test_basic_select -!/**************************************************************** +!*************************************************************** !** !** test_select_point(): Test basic H5S (dataspace) selection code. !** Tests element selections between dataspaces of various sizes !** and dimensionalities. !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_select_point(cleanup, total_error) USE HDF5 ! This module contains all necessary modules @@ -1056,29 +1056,29 @@ SUBROUTINE test_select_point(cleanup, total_error) INTEGER, PARAMETER :: SPACE2_RANK=2 INTEGER, PARAMETER :: SPACE3_RANK=2 - ! /* Element selection information */ + ! Element selection information INTEGER, PARAMETER :: POINT1_NPOINTS=10 - INTEGER(hid_t) ::fid1 ! /* HDF5 File IDs */ - INTEGER(hid_t) ::dataset ! /* Dataset ID */ - INTEGER(hid_t) ::sid1,sid2 ! /* Dataspace ID */ + INTEGER(hid_t) ::fid1 ! HDF5 File IDs + INTEGER(hid_t) ::dataset ! Dataset ID + INTEGER(hid_t) ::sid1,sid2 ! Dataspace ID INTEGER(hsize_t), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) INTEGER(hsize_t), DIMENSION(1:2) :: dims2 = (/SPACE2_DIM1, SPACE2_DIM2/) INTEGER(hsize_t), DIMENSION(1:2) :: dims3 = (/SPACE3_DIM1, SPACE3_DIM2/) - INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 !/* Coordinates for point selection */ - INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 !/* Coordinates for point selection */ - INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 !/* Coordinates for point selection */ - INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 !/* Coordinates for point selection */ - INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 !/* Coordinates for point selection */ - INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 !/* Coordinates for point selection */ + INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 ! Coordinates for point selection INTEGER(hssize_t) :: npoints -!!$ uint8_t *wbuf, /* buffer to write to disk */ -!!$ *rbuf, /* buffer read from disk */ -!!$ *tbuf; /* temporary buffer pointer */ - INTEGER :: i,j; !/* Counters */ -! struct pnt_iter pi; /* Custom Pointer iterator struct */ - INTEGER :: error !/* Generic return value */ +!!$ uint8_t *wbuf, buffer to write to disk +!!$ *rbuf, buffer read from disk +!!$ *tbuf; temporary buffer pointer + INTEGER :: i,j; ! Counters +! struct pnt_iter pi; Custom Pointer iterator struct + INTEGER :: error ! Generic return value CHARACTER(LEN=9) :: filename = 'h5s_hyper' CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf @@ -1091,11 +1091,11 @@ SUBROUTINE test_select_point(cleanup, total_error) xfer_plist = H5P_DEFAULT_F ! MESSAGE(5, ("Testing Element Selection Functions\n")); - !/* Allocate write & read buffers */ + ! Allocate write & read buffers !!$ wbuf = HDmalloc(sizeof(uint8_t) * SPACE2_DIM1 * SPACE2_DIM2); !!$ rbuf = HDcalloc(sizeof(uint8_t), (size_t)(SPACE3_DIM1 * SPACE3_DIM2)); !!$ - !/* Initialize WRITE buffer */ + ! Initialize WRITE buffer DO i = 1, SPACE2_DIM1 DO j = 1, SPACE2_DIM2 @@ -1107,19 +1107,19 @@ SUBROUTINE test_select_point(cleanup, total_error) !!$ for(j=0; j<SPACE2_DIM2; j++) !!$ *tbuf++=(uint8_t)((i*SPACE2_DIM2)+j); - !/* Create file */ + ! Create file CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid1, error) CALL check("h5fcreate_f", error, total_error) - !/* Create dataspace for dataset */ + ! Create dataspace for dataset CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error) CALL check("h5screate_simple_f", error, total_error) - !/* Create dataspace for write buffer */ + ! Create dataspace for write buffer CALL h5screate_simple_f(SPACE2_RANK, dims2, sid2, error) CALL check("h5screate_simple_f", error, total_error) - !/* Select sequence of ten points for disk dataset */ + ! Select sequence of ten points for disk dataset coord1(1,1)=1; coord1(2,1)=11; coord1(3,1)= 6; coord1(1,2)=2; coord1(2,2)= 3; coord1(3,2)= 8; coord1(1,3)=3; coord1(2,3)= 5; coord1(3,3)=10; @@ -1134,7 +1134,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL h5sselect_elements_f(sid1, H5S_SELECT_SET_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error) CALL check("h5sselect_elements_f", error, total_error) - !/* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid1, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1149,7 +1149,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sget_select_npoints_f", error, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) - !/* Append another sequence of ten points to disk dataset */ + ! Append another sequence of ten points to disk dataset coord1(1,1)=1; coord1(2,1)=3; coord1(3,1)= 1; coord1(1,2)=2; coord1(2,2)=11; coord1(3,2)= 9; @@ -1165,7 +1165,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL h5sselect_elements_f(sid1, H5S_SELECT_APPEND_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error) CALL check("h5sselect_elements_f", error, total_error) - ! /* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid1, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1180,7 +1180,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sget_select_npoints_f", error, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) - ! /* Select sequence of ten points for memory dataset */ + ! Select sequence of ten points for memory dataset coord2(1,1)=13; coord2(2,1)= 4; coord2(1,2)=16; coord2(2,2)=14; coord2(1,3)= 8; coord2(2,3)=26; @@ -1196,7 +1196,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sselect_elements_f", error, total_error) - !/* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1207,9 +1207,9 @@ SUBROUTINE test_select_point(cleanup, total_error) ENDDO !!$ -!!$ /* Save points for later iteration */ -!!$ /* (these are in the second half of the buffer, because we are prepending */ -!!$ /* the next list of points to the beginning of the point selection list) */ +!!$ Save points for later iteration +!!$ (these are in the second half of the buffer, because we are prepending +!!$ the next list of points to the beginning of the point selection list) !!$ HDmemcpy(((char *)pi.coord)+sizeof(coord2),coord2,sizeof(coord2)); !!$ @@ -1217,7 +1217,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sget_select_npoints_f", error, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) - !/* Append another sequence of ten points to memory dataset */ + ! Append another sequence of ten points to memory dataset coord2(1,1)=25; coord2(2,1)= 1; coord2(1,2)= 3; coord2(2,2)=26; coord2(1,3)=14; coord2(2,3)=18; @@ -1233,7 +1233,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sselect_elements_f", error, total_error) - !/* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1246,26 +1246,26 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sget_select_npoints_f", error, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) -!!$ /* Save points for later iteration */ +!!$ Save points for later iteration !!$ HDmemcpy(pi.coord,coord2,sizeof(coord2)); - ! /* Create a dataset */ + ! Create a dataset CALL h5dcreate_f(fid1, "Dataset1", H5T_NATIVE_CHARACTER, sid1, dataset, error) CALL check("h5dcreate_f", error, total_error) - ! /* Write selection to disk */ + ! Write selection to disk CALL h5dwrite_f(dataset, H5T_NATIVE_CHARACTER, wbuf, dims2, error, sid2, sid1, xfer_plist) CALL check("h5dwrite_f", error, total_error) - ! /* Close memory dataspace */ + ! Close memory dataspace CALL h5sclose_f(sid2, error) CALL check("h5sclose_f", error, total_error) - ! /* Create dataspace for reading buffer */ + ! Create dataspace for reading buffer CALL h5screate_simple_f(SPACE3_RANK, dims3, sid2, error) CALL check("h5screate_simple_f", error, total_error) - ! /* Select sequence of points for read dataset */ + ! Select sequence of points for read dataset coord3(1,1)= 1; coord3(2,1)= 3; coord3(1,2)= 5; coord3(2,2)= 9; coord3(1,3)=14; coord3(2,3)=14; @@ -1280,7 +1280,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error) CALL check("h5sselect_elements_f", error, total_error) - ! /* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) DO i= 1, POINT1_NPOINTS @@ -1292,7 +1292,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL check("h5sget_select_npoints_f", error, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error) - !/* Append another sequence of ten points to disk dataset */ + ! Append another sequence of ten points to disk dataset coord3(1,1)=15; coord3(2,1)=26; coord3(1,2)= 1; coord3(2,2)= 1; coord3(1,3)=12; coord3(2,3)=12; @@ -1307,7 +1307,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL h5sselect_elements_f(sid2, H5S_SELECT_APPEND_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error) CALL check("h5sselect_elements_f", error, total_error) - ! /* Verify correct elements selected */ + ! Verify correct elements selected CALL h5sget_select_elem_pointlist_f(sid2, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) DO i= 1, POINT1_NPOINTS @@ -1320,11 +1320,11 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error) ! F2003 feature -!!$ /* Read selection from disk */ +!!$ Read selection from disk !!$ ret=H5Dread(dataset,H5T_NATIVE_UCHAR,sid2,sid1,xfer_plist,rbuf); !!$ CHECK(ret, FAIL, "H5Dread"); !!$ -!!$ /* Check that the values match with a dataset iterator */ +!!$ Check that the values match with a dataset iterator !!$ pi.buf=wbuf; !!$ pi.offset=0; !!$ ret = H5Diterate(rbuf,H5T_NATIVE_UCHAR,sid2,test_select_point_iter1,&pi); @@ -1332,19 +1332,19 @@ SUBROUTINE test_select_point(cleanup, total_error) !!$ ! F2003 feature - !/* Close memory dataspace */ + ! Close memory dataspace CALL h5sclose_f(sid2, error) CALL check("h5sclose_f", error, total_error) - !/* Close disk dataspace */ + ! Close disk dataspace CALL h5sclose_f(sid1, error) CALL check("h5sclose_f", error, total_error) - !/* Close Dataset */ + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f", error, total_error) - !/* Close file */ + ! Close file CALL h5fclose_f(fid1, error) CALL check("h5fclose_f", error, total_error) @@ -1354,13 +1354,13 @@ SUBROUTINE test_select_point(cleanup, total_error) END SUBROUTINE test_select_point -!/**************************************************************** +!*************************************************************** !** !** test_select_combine(): Test basic H5S (dataspace) selection code. !** Tests combining "all" and "none" selections with hyperslab !** operations. !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_select_combine(total_error) USE HDF5 ! This module contains all necessary modules @@ -1373,25 +1373,25 @@ SUBROUTINE test_select_combine(total_error) INTEGER, PARAMETER :: SPACE7_DIM1 = 10 INTEGER, PARAMETER :: SPACE7_DIM2 = 10 - INTEGER(hid_t) :: base_id ! /* Base dataspace for test */ - INTEGER(hid_t) :: all_id ! /* Dataspace for "all" selection */ - INTEGER(hid_t) :: none_id ! /* Dataspace for "none" selection */ - INTEGER(hid_t) :: space1 ! /* Temporary dataspace #1 */ - INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: start ! /* Hyperslab start */ - INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: stride ! /* Hyperslab stride */ - INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: icount ! /* Hyperslab count */ - INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: iblock ! /* Hyperslab BLOCK */ - INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: dims = (/SPACE7_DIM1,SPACE7_DIM2/) !/* Dimensions of dataspace */ - INTEGER :: sel_type ! /* Selection type */ - INTEGER(hssize_t) :: nblocks !/* Number of hyperslab blocks */ - INTEGER(hsize_t), DIMENSION(1:128,1:2,1:SPACE7_RANK) :: blocks ! /* List of blocks */ + INTEGER(hid_t) :: base_id ! Base dataspace for test + INTEGER(hid_t) :: all_id ! Dataspace for "all" selection + INTEGER(hid_t) :: none_id ! Dataspace for "none" selection + INTEGER(hid_t) :: space1 ! Temporary dataspace #1 + INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: start ! Hyperslab start + INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: stride ! Hyperslab stride + INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: icount ! Hyperslab count + INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: iblock ! Hyperslab BLOCK + INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: dims = (/SPACE7_DIM1,SPACE7_DIM2/) ! Dimensions of dataspace + INTEGER :: sel_type ! Selection type + INTEGER(hssize_t) :: nblocks ! Number of hyperslab blocks + INTEGER(hsize_t), DIMENSION(1:128,1:2,1:SPACE7_RANK) :: blocks ! List of blocks INTEGER :: error, area - !/* Create dataspace for dataset on disk */ + ! Create dataspace for dataset on disk CALL h5screate_simple_f(SPACE7_RANK, dims, base_id, error) CALL check("h5screate_simple_f", error, total_error) - ! /* Copy base dataspace and set selection to "all" */ + ! Copy base dataspace and set selection to "all" CALL h5scopy_f(base_id, all_id, error) CALL check("h5scopy_f", error, total_error) @@ -1402,7 +1402,7 @@ SUBROUTINE test_select_combine(total_error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error) - !/* Copy base dataspace and set selection to "none" */ + ! Copy base dataspace and set selection to "none" CALL h5scopy_f(base_id, none_id, error) CALL check("h5scopy_f", error, total_error) @@ -1413,11 +1413,11 @@ SUBROUTINE test_select_combine(total_error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error) - !/* Copy "all" selection & space */ + ! Copy "all" selection & space CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) - !/* 'OR' "all" selection with another hyperslab */ + ! 'OR' "all" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1426,20 +1426,20 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Verify that it's still "all" selection */ + ! Verify that it's still "all" selection CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error) - !/* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - !/* Copy "all" selection & space */ + ! Copy "all" selection & space CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'AND' "all" selection with another hyperslab */ + ! 'AND' "all" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1448,36 +1448,36 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Verify that the new selection is the same at the original block */ + ! Verify that the new selection is the same at the original block CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - !/* Verify that there is only one block */ + ! Verify that there is only one block CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) - !/* Retrieve the block defined */ + ! Retrieve the block defined CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - !/* Verify that the correct block is defined */ + ! Verify that the correct block is defined CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - !/* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - !/* Copy "all" selection & space */ + ! Copy "all" selection & space CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'XOR' "all" selection with another hyperslab */ + ! 'XOR' "all" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1487,23 +1487,23 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is an inversion of the original block */ + ! Verify that the new selection is an inversion of the original block CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - ! /* Verify that there are two blocks */ + ! Verify that there are two blocks CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error) - ! /* Retrieve the block defined */ + ! Retrieve the block defined - blocks = -1 ! /* Reset block list */ + blocks = -1 ! Reset block list CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! Verify that the correct block is defined ! No guarantee is implied as the order in which blocks are listed. ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) @@ -1521,15 +1521,15 @@ SUBROUTINE test_select_combine(total_error) area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1) CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error) - !/* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "all" selection & space */ + ! Copy "all" selection & space CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'NOTB' "all" selection with another hyperslab */ + ! 'NOTB' "all" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1539,22 +1539,22 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is an inversion of the original block */ + ! Verify that the new selection is an inversion of the original block CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - ! /* Verify that there are two blocks */ + ! Verify that there are two blocks CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error) - ! /* Retrieve the block defined */ - blocks = -1 ! /* Reset block list */ + ! Retrieve the block defined + blocks = -1 ! Reset block list CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! Verify that the correct block is defined ! No guarantee is implied as the order in which blocks are listed. ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) @@ -1574,14 +1574,14 @@ SUBROUTINE test_select_combine(total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "all" selection & space */ + ! Copy "all" selection & space CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'NOTA' "all" selection with another hyperslab */ + ! 'NOTA' "all" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1591,20 +1591,20 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Verify that the new selection is the "none" selection */ + ! Verify that the new selection is the "none" selection CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "none" selection & space */ + ! Copy "none" selection & space CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'OR' "none" selection with another hyperslab */ + ! 'OR' "none" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1614,37 +1614,37 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is the same as the original hyperslab */ + ! Verify that the new selection is the same as the original hyperslab CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - ! /* Verify that there is only one block */ + ! Verify that there is only one block CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) - ! /* Retrieve the block defined */ - blocks = -1 ! /* Reset block list */ + ! Retrieve the block defined + blocks = -1 ! Reset block list CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! Verify that the correct block is defined CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "none" selection & space */ + ! Copy "none" selection & space CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'AND' "none" selection with another hyperslab */ + ! 'AND' "none" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1654,20 +1654,20 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is the "none" selection */ + ! Verify that the new selection is the "none" selection CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "none" selection & space */ + ! Copy "none" selection & space CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'XOR' "none" selection with another hyperslab */ + ! 'XOR' "none" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1677,36 +1677,36 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is the same as the original hyperslab */ + ! Verify that the new selection is the same as the original hyperslab CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - ! /* Verify that there is only one block */ + ! Verify that there is only one block CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) - ! /* Retrieve the block defined */ - blocks = -1 ! /* Reset block list */ + ! Retrieve the block defined + blocks = -1 ! Reset block list CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! Verify that the correct block is defined CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "none" selection & space */ + ! Copy "none" selection & space CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'NOTB' "none" selection with another hyperslab */ + ! 'NOTB' "none" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1716,20 +1716,20 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is the "none" selection */ + ! Verify that the new selection is the "none" selection CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Copy "none" selection & space */ + ! Copy "none" selection & space CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) - ! /* 'NOTA' "none" selection with another hyperslab */ + ! 'NOTA' "none" selection with another hyperslab start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 @@ -1738,35 +1738,35 @@ SUBROUTINE test_select_combine(total_error) icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) - ! /* Verify that the new selection is the same as the original hyperslab */ + ! Verify that the new selection is the same as the original hyperslab CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - ! /* Verify that there is ONLY one BLOCK */ + ! Verify that there is ONLY one BLOCK CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) - ! /* Retrieve the block defined */ + ! Retrieve the block defined - blocks = -1 ! /* Reset block list */ + blocks = -1 ! Reset block list CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! Verify that the correct block is defined CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - ! /* Close temporary dataspace */ + ! Close temporary dataspace CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) - ! /* Close dataspaces */ + ! Close dataspaces CALL h5sclose_f(base_id, error) CALL check("h5sclose_f", error, total_error) @@ -1777,12 +1777,12 @@ SUBROUTINE test_select_combine(total_error) END SUBROUTINE test_select_combine -!/**************************************************************** +!*************************************************************** !** !** test_select_bounds(): Tests selection bounds on dataspaces, !** both with and without offsets. !** -!****************************************************************/ +!*************************************************************** SUBROUTINE test_select_bounds(total_error) USE HDF5 ! This module contains all necessary modules @@ -1796,24 +1796,24 @@ SUBROUTINE test_select_bounds(total_error) INTEGER, PARAMETER :: SPACE11_DIM2=50 INTEGER, PARAMETER :: SPACE11_NPOINTS=4 - INTEGER(hid_t) :: sid ! /* Dataspace ID */ + INTEGER(hid_t) :: sid ! Dataspace ID INTEGER(hsize_t), DIMENSION(1:SPACE11_RANK) :: dims = (/SPACE11_DIM1, SPACE11_DIM2/) !Dataspace dimensions - INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord !/* Coordinates for point selection - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: start ! /* The start of the hyperslab */ - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: stride !/* The stride between block starts for the hyperslab */ - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: count !/* The number of blocks for the hyperslab */ - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: BLOCK !/* The size of each block for the hyperslab */ - INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset !/* Offset amount for selection */ - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds !/* The low bounds for the selection */ - INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds !/* The high bounds for the selection */ + INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord ! Coordinates for point selection + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: start ! The start of the hyperslab + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: stride ! The stride between block starts for the hyperslab + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: count ! The number of blocks for the hyperslab + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: BLOCK ! The size of each block for the hyperslab + INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset ! Offset amount for selection + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds ! The low bounds for the selection + INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds ! The high bounds for the selection INTEGER :: error - !/* Create dataspace */ + ! Create dataspace CALL h5screate_simple_f(SPACE11_RANK, dims, sid, error) CALL check("h5screate_simple_f", error, total_error) - ! /* Get bounds for 'all' selection */ + ! Get bounds for 'all' selection CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1822,12 +1822,12 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error) - !/* Set offset for selection */ + ! Set offset for selection offset(1:2) = 1 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - !/* Get bounds for 'all' selection with offset (which should be ignored) */ + ! Get bounds for 'all' selection with offset (which should be ignored) CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1836,20 +1836,20 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error) CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error) - !/* Reset offset for selection */ + ! Reset offset for selection offset(1:2) = 0 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - !/* Set 'none' selection */ + ! Set 'none' selection CALL H5Sselect_none_f(sid, error) CALL check("H5Sselect_none_f", error, total_error) - !/* Get bounds for 'none' selection, should fail */ + ! Get bounds for 'none' selection, should fail CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) - !/* Set point selection */ + ! Set point selection coord(1,1)= 3; coord(2,1)= 3; coord(1,2)= 3; coord(2,2)= 46; @@ -1859,7 +1859,7 @@ SUBROUTINE test_select_bounds(total_error) CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, SPACE11_RANK, INT(SPACE11_NPOINTS,size_t), coord, error) CALL check("h5sselect_elements_f", error, total_error) - !/* Get bounds for point selection */ + ! Get bounds for point selection CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1868,22 +1868,22 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error) - ! /* Set bad offset for selection */ + ! Set bad offset for selection offset(1:2) = (/5,-5/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Get bounds for hyperslab selection with negative offset */ + ! Get bounds for hyperslab selection with negative offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) - ! /* Set valid offset for selection */ + ! Set valid offset for selection offset(1:2) = (/2,-2/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Get bounds for point selection with offset */ + ! Get bounds for point selection with offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1892,12 +1892,12 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error) - ! /* Reset offset for selection */ + ! Reset offset for selection offset(1:2) = 0 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Set "regular" hyperslab selection */ + ! Set "regular" hyperslab selection start(1:2) = 2 stride(1:2) = 10 count(1:2) = 4 @@ -1907,7 +1907,7 @@ SUBROUTINE test_select_bounds(total_error) count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Get bounds for hyperslab selection */ + ! Get bounds for hyperslab selection CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1916,21 +1916,21 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 37, total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 37, total_error) - !/* Set bad offset for selection */ + ! Set bad offset for selection offset(1:2) = (/5,-5/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Get bounds for hyperslab selection with negative offset */ + ! Get bounds for hyperslab selection with negative offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) - ! /* Set valid offset for selection */ + ! Set valid offset for selection offset(1:2) = (/5,-2/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - !/* Get bounds for hyperslab selection with offset */ + ! Get bounds for hyperslab selection with offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1939,12 +1939,12 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 42, total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 35, total_error) - !/* Reset offset for selection */ + ! Reset offset for selection offset(1:2) = 0 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Make "irregular" hyperslab selection */ + ! Make "irregular" hyperslab selection start(1:2) = 20 stride(1:2) = 20 count(1:2) = 2 @@ -1954,7 +1954,7 @@ SUBROUTINE test_select_bounds(total_error) count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) - !/* Get bounds for hyperslab selection */ + ! Get bounds for hyperslab selection CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1963,21 +1963,21 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 50, total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 50, total_error) - ! /* Set bad offset for selection */ + ! Set bad offset for selection offset(1:2) = (/5,-5/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - ! /* Get bounds for hyperslab selection with negative offset */ + ! Get bounds for hyperslab selection with negative offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) - !/* Set valid offset for selection */ + ! Set valid offset for selection offset(1:2) = (/5,-2/) CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - !/* Get bounds for hyperslab selection with offset */ + ! Get bounds for hyperslab selection with offset CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -1986,12 +1986,12 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 55, total_error) CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 48, total_error) - !/* Reset offset for selection */ + ! Reset offset for selection offset(1:2) = 0 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - !/* Close the dataspace */ + ! Close the dataspace CALL h5sclose_f(sid, error) CALL check("h5sclose_f", error, total_error) diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 8ac91d2..7822c16 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -112,7 +112,7 @@ CONTAINS INTEGER(HID_T) :: decoded_tid1 INTEGER(HID_T) :: fixed_str1, fixed_str2 - LOGICAL :: are_equal, differ + LOGICAL :: are_equal INTEGER(SIZE_T), PARAMETER :: str_size = 10 INTEGER(SIZE_T) :: query_size @@ -556,13 +556,13 @@ CONTAINS ! * Test encoding and decoding compound datatypes ! *----------------------------------------------------------------------- ! - ! /* Encode compound type in a buffer */ + ! Encode compound type in a buffer ! -- First find the buffer size CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) CALL check("H5Tencode_f", error, total_error) - ! /* Try decoding bogus buffer */ + ! Try decoding bogus buffer CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) CALL VERIFY("H5Tdecode_f", error, -1, total_error) @@ -570,11 +570,11 @@ CONTAINS CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) CALL check("H5Tencode_f", error, total_error) - ! /* Decode from the compound buffer and return an object handle */ + ! Decode from the compound buffer and return an object handle CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) CALL check("H5Tdecode_f", error, total_error) - ! /* Verify that the datatype was copied exactly */ + ! Verify that the datatype was copied exactly CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) CALL check("H5Tequal_f", error, total_error) @@ -897,7 +897,7 @@ CONTAINS CALL H5Tget_native_type_f(dtype, H5T_DIR_ASCEND_F, native_type, error) CALL check("H5Tget_native_type_f",error, total_error) - !/* Verify the datatype retrieved and converted */ + ! Verify the datatype retrieved and converted CALL H5Tget_order_f(native_type, order1, error) CALL check("H5Tget_order_f",error, total_error) CALL H5Tget_order_f(H5T_NATIVE_INTEGER, order2, error) @@ -952,7 +952,7 @@ CONTAINS RETURN END SUBROUTINE enumtest -!/*------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! * Function: test_derived_flt ! * ! * Purpose: Tests user-define and query functions of floating-point types. @@ -968,7 +968,7 @@ CONTAINS ! * Modifications: ! * ! *------------------------------------------------------------------------- -! */ +! SUBROUTINE test_derived_flt(cleanup, total_error) @@ -990,7 +990,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) INTEGER :: error - !/* Create File */ + ! Create File CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN WRITE(*,*) "Cannot modify filename" @@ -1009,7 +1009,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL h5tcopy_f(H5T_IEEE_F32LE, tid2, error) CALL check("h5tcopy_f",error,total_error) - !/*------------------------------------------------------------------------ + !------------------------------------------------------------------------ ! * 1st floating-point type ! * size=7 byte, precision=42 bits, offset=3 bits, mantissa size=31 bits, ! * mantissa position=3, exponent size=10 bits, exponent position=34, @@ -1026,7 +1026,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) ! * bigger than original size but can be decreased. There should be no ! * holes among the significant bits. Exponent bias usually is set ! * 2^(n-1)-1, where n is the exponent size. - ! *-----------------------------------------------------------------------*/ + ! *----------------------------------------------------------------------- CALL H5Tset_fields_f(tid1, INT(44,size_t), INT(34,size_t), INT(10,size_t), & INT(3,size_t), INT(31,size_t), error) @@ -1079,7 +1079,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL check("H5Tget_ebias_f", error, total_error) CALL VERIFY("H5Tget_ebias_f", INT(ebias1), 511, total_error) - !/*-------------------------------------------------------------------------- + !-------------------------------------------------------------------------- ! * 2nd floating-point type ! * size=3 byte, precision=24 bits, offset=0 bits, mantissa size=16 bits, ! * mantissa position=0, exponent size=7 bits, exponent position=16, exponent @@ -1087,7 +1087,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) ! * ! * 2 1 0 ! * SEEEEEEE MMMMMMMM MMMMMMMM - ! *--------------------------------------------------------------------------*/ + ! *-------------------------------------------------------------------------- CALL H5Tset_fields_f(tid2, INT(23,size_t), INT(16,size_t), INT(7,size_t), & INT(0,size_t), INT(16,size_t), error) diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index e019d0f..32531b0 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -34,12 +34,12 @@ ! *** H 5 T T E S T S ! ***************************************** -!/**************************************************************** +!*************************************************************** !** !** test_array_compound_atomic(): Test basic array datatype code. !** Tests 1-D array of compound datatypes (with no array fields) !** -!****************************************************************/ +!*************************************************************** ! MODULE TH5T_F03 diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90 index f063722..651ca75 100644 --- a/fortran/test/tH5VL.f90 +++ b/fortran/test/tH5VL.f90 @@ -226,7 +226,6 @@ CONTAINS INTEGER(SIZE_T) max_len INTEGER(HID_T) :: vl_type_id LOGICAL :: vl_flag - LOGICAL :: differ ! ! Initialize the vl_int_data array. diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90 index 6d5911f..450daf2 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -134,6 +134,22 @@ CONTAINS !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_TEST_DLL) +!DEC$attributes dllexport :: verify_INTEGER_HID_T +!DEC$endif + SUBROUTINE verify_INTEGER_HID_T(string,value,correct_value,total_error) + USE HDF5 + CHARACTER(LEN=*) :: string + INTEGER(HID_T) :: value, correct_value + INTEGER :: total_error + IF (value .NE. correct_value) THEN + total_error=total_error+1 + WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string + ENDIF + RETURN + END SUBROUTINE verify_INTEGER_HID_T + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_TEST_DLL) !DEC$attributes dllexport :: verify_Fortran_INTEGER_4 !DEC$endif SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error) diff --git a/fortran/testpar/CMakeLists.txt b/fortran/testpar/CMakeLists.txt index dfe9ce7..98ef6c8 100644 --- a/fortran/testpar/CMakeLists.txt +++ b/fortran/testpar/CMakeLists.txt @@ -4,7 +4,7 @@ PROJECT (HDF5_FORTRAN_TESTPAR C CXX Fortran) #----------------------------------------------------------------------------- # Setup include Directories #----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${CMAKE_Fortran_MODULE_DIRECTORY} ${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) +INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) #----------------------------------------------------------------------------- # Add Tests @@ -17,7 +17,7 @@ add_executable (parallel_test mdset.f90 ) TARGET_NAMING (parallel_test ${LIB_TYPE}) -TARGET_FORTRAN_PROPERTIES (parallel_test " " " ") +TARGET_FORTRAN_PROPERTIES (parallel_test ${LIB_TYPE} " " " ") target_link_libraries (parallel_test ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} @@ -27,6 +27,7 @@ target_link_libraries (parallel_test if (WIN32 AND MSVC) target_link_libraries (parallel_test "ws2_32.lib") endif (WIN32 AND MSVC) +target_include_directories (parallel_test PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}) set_target_properties (parallel_test PROPERTIES LINKER_LANGUAGE Fortran) set_target_properties (parallel_test PROPERTIES FOLDER test/fortran) |