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/test | |
| 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/test')
| -rw-r--r-- | fortran/test/CMakeLists.txt | 58 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_1_8.f90 | 8 | ||||
| -rw-r--r-- | fortran/test/t.h | 2 | ||||
| -rw-r--r-- | fortran/test/tH5A.f90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5A_1_8.f90 | 688 | ||||
| -rw-r--r-- | fortran/test/tH5E_F03.f90 | 8 | ||||
| -rw-r--r-- | fortran/test/tH5F.f90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5G_1_8.f90 | 620 | ||||
| -rw-r--r-- | fortran/test/tH5MISC_1_8.f90 | 80 | ||||
| -rw-r--r-- | fortran/test/tH5O.f90 | 8 | ||||
| -rw-r--r-- | fortran/test/tH5O_F03.f90 | 4 | ||||
| -rw-r--r-- | fortran/test/tH5P.f90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.f90 | 99 | ||||
| -rw-r--r-- | fortran/test/tH5Sselect.f90 | 340 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 26 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.f90 | 4 | ||||
| -rw-r--r-- | fortran/test/tH5VL.f90 | 1 | ||||
| -rw-r--r-- | fortran/test/tf.f90 | 16 |
18 files changed, 1012 insertions, 956 deletions
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) |