diff options
Diffstat (limited to 'fortran')
92 files changed, 8051 insertions, 5698 deletions
diff --git a/fortran/CMakeLists.txt b/fortran/CMakeLists.txt index f7179cf..7b90d83 100644 --- a/fortran/CMakeLists.txt +++ b/fortran/CMakeLists.txt @@ -1,9 +1,7 @@ -cmake_minimum_required (VERSION 3.2.2) -PROJECT (HDF5_F90 C CXX Fortran) +cmake_minimum_required (VERSION 3.12) +project (HDF5_F90 C Fortran) if (H5_HAVE_PARALLEL) - INCLUDE (FindMPI) - set (LINK_LIBS ${LINK_LIBS} ${MPI_Fortran_LIBRARIES}) if (MPI_Fortran_LINK_FLAGS) set (CMAKE_EXE_LINKER_FLAGS "${MPI_Fortran_LINK_FLAGS} ${CMAKE_EXE_LINKER_FLAGS}") endif () @@ -12,21 +10,21 @@ endif () #----------------------------------------------------------------------------- # Traverse source subdirectory #----------------------------------------------------------------------------- -add_subdirectory (${HDF5_F90_SOURCE_DIR}/src ${HDF5_F90_BINARY_DIR}/src) +add_subdirectory (src) #----------------------------------------------------------------------------- # Build the Fortran Examples #----------------------------------------------------------------------------- if (HDF5_BUILD_EXAMPLES) - add_subdirectory (${HDF5_F90_SOURCE_DIR}/examples ${HDF5_F90_BINARY_DIR}/examples) + add_subdirectory (examples) endif () #----------------------------------------------------------------------------- # Testing #----------------------------------------------------------------------------- if (BUILD_TESTING) - add_subdirectory (${HDF5_F90_SOURCE_DIR}/test ${HDF5_F90_BINARY_DIR}/test) + add_subdirectory (test) if (MPI_Fortran_FOUND) - add_subdirectory (${HDF5_F90_SOURCE_DIR}/testpar ${HDF5_F90_BINARY_DIR}/testpar) + add_subdirectory (testpar) endif () endif () diff --git a/fortran/Makefile.am b/fortran/Makefile.am index 38084b9..c07fa3e 100644 --- a/fortran/Makefile.am +++ b/fortran/Makefile.am @@ -22,14 +22,27 @@ include $(top_srcdir)/config/commence.am -if BUILD_PARALLEL_CONDITIONAL +if BUILD_TESTS_PARALLEL_CONDITIONAL TESTPARALLEL_DIR=testpar +else + TESTPARALLEL_DIR= +endif +if BUILD_TESTS_CONDITIONAL + TESTSERIAL_DIR=test +else + TESTSERIAL_DIR= endif # Subdirectories in build order, not including examples directory ## Only recurse into subdirectories if HDF5 is configured to use Fortran. if BUILD_FORTRAN_CONDITIONAL - SUBDIRS=src test $(TESTPARALLEL_DIR) + SUBDIRS=src $(TESTSERIAL_DIR) $(TESTPARALLEL_DIR) + +# Test with just the native connector, with a single pass-through connector +# and with a doubly-stacked pass-through. +VOL_LIST = native "pass_through under_vol=0;under_info={}" \ + "pass_through under_vol=505;under_info={under_vol=0;under_info={}}" + endif # All directories that have Makefiles diff --git a/fortran/examples/CMakeLists.txt b/fortran/examples/CMakeLists.txt index a5c3422..02a71c3 100644 --- a/fortran/examples/CMakeLists.txt +++ b/fortran/examples/CMakeLists.txt @@ -1,16 +1,11 @@ -cmake_minimum_required (VERSION 3.2.2) -PROJECT (HDF5_F90_EXAMPLES C CXX Fortran) +cmake_minimum_required (VERSION 3.12) +project (HDF5_F90_EXAMPLES C Fortran) # -------------------------------------------------------------------- # Notes: When creating examples they should be prefixed # with "f90_ex_". This allows for easier filtering of the examples. # -------------------------------------------------------------------- #----------------------------------------------------------------------------- -# Setup include Directories -#----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) - -#----------------------------------------------------------------------------- # Define Sources #----------------------------------------------------------------------------- set (examples @@ -40,28 +35,38 @@ set (F2003_examples foreach (example ${examples}) add_executable (f90_ex_${example} ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) - TARGET_NAMING (f90_ex_${example} STATIC) - TARGET_FORTRAN_PROPERTIES (f90_ex_${example} STATIC " " " ") - target_link_libraries (f90_ex_${example} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} - ) - target_include_directories (f90_ex_${example} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) - set_target_properties (f90_ex_${example} PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER examples/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static - ) - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (f90_ex_${example}-shared ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) - TARGET_NAMING (f90_ex_${example}-shared SHARED) - TARGET_FORTRAN_PROPERTIES (f90_ex_${example}-shared SHARED " " " ") - target_link_libraries (f90_ex_${example}-shared - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} + target_compile_options(f90_ex_${example} PRIVATE $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}>) +# set_property(TARGET f90_ex_${example} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET f90_ex_${example} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) + if(MSVC) + set_property(TARGET f90_ex_${example} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") + endif() + if (NOT BUILD_SHARED_LIBS) + target_include_directories (f90_ex_${example} + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/static" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/static" ) - target_include_directories (f90_ex_${example}-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (f90_ex_${example}-shared PROPERTIES + target_link_libraries (f90_ex_${example} PRIVATE ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET}) + set_target_properties (f90_ex_${example} PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + else () + target_include_directories (f90_ex_${example} + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/shared" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/shared" + ) + target_link_libraries (f90_ex_${example} PRIVATE ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET}) + set_target_properties (f90_ex_${example} PROPERTIES LINKER_LANGUAGE Fortran FOLDER examples/fortran Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared @@ -71,28 +76,38 @@ endforeach () foreach (example ${F2003_examples}) add_executable (f03_ex_${example} ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) - TARGET_NAMING (f03_ex_${example} STATIC) - TARGET_FORTRAN_PROPERTIES (f03_ex_${example} STATIC " " " ") - target_link_libraries (f03_ex_${example} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} - ) - target_include_directories (f03_ex_${example} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) - set_target_properties (f03_ex_${example} PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER examples/fortran03 - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} - ) - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (f03_ex_${example}-shared ${HDF5_F90_EXAMPLES_SOURCE_DIR}/${example}.f90) - TARGET_NAMING (f03_ex_${example}-shared SHARED) - TARGET_FORTRAN_PROPERTIES (f03_ex_${example}-shared SHARED " " " ") - target_link_libraries (f03_ex_${example}-shared - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} + target_compile_options(f03_ex_${example} PRIVATE $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}>) +# set_property(TARGET f03_ex_${example} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET f03_ex_${example} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) + if(MSVC) + set_property(TARGET f03_ex_${example} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") + endif() + if (NOT ONLY_SHARED_LIBS) + target_include_directories (f03_ex_${example} + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/static" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/static" ) - target_include_directories (f03_ex_${example}-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (f03_ex_${example}-shared PROPERTIES + target_link_libraries (f03_ex_${example} PRIVATE ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET}) + set_target_properties (f03_ex_${example} PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran03 + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + else () + target_include_directories (f03_ex_${example} + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/shared" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/shared" + ) + target_link_libraries (f03_ex_${example} PRIVATE ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET}) + set_target_properties (f03_ex_${example} PROPERTIES LINKER_LANGUAGE Fortran FOLDER examples/fortran03 Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared @@ -102,30 +117,50 @@ endforeach () if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) add_executable (f90_ex_ph5example ${HDF5_F90_EXAMPLES_SOURCE_DIR}/ph5example.f90) - TARGET_NAMING (f90_ex_ph5example STATIC) - TARGET_FORTRAN_PROPERTIES (f90_ex_ph5example STATIC " " " ") - target_link_libraries (f90_ex_ph5example - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} - ${MPI_Fortran_LIBRARIES} - ) - target_include_directories (f90_ex_ph5example PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) - set_target_properties (f90_ex_ph5example PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER examples/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static - ) - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (f90_ex_ph5example-shared ${HDF5_F90_EXAMPLES_SOURCE_DIR}/ph5example.f90) - TARGET_NAMING (f90_ex_ph5example-shared SHARED) - TARGET_FORTRAN_PROPERTIES (f90_ex_ph5example-shared SHARED " " " ") - target_link_libraries (f90_ex_ph5example-shared - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} - ${MPI_Fortran_LIBRARIES} + target_compile_options(f90_ex_ph5example PRIVATE $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}>) +# set_property(TARGET f90_ex_ph5example APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET f90_ex_ph5example APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) + if(MSVC) + set_property(TARGET f90_ex_ph5example PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") + endif() + if (NOT ONLY_SHARED_LIBS) + target_include_directories (f90_ex_ph5example + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/static" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/static" + "$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_INCLUDE_DIRS}>" + ) + target_link_libraries (f90_ex_ph5example + PRIVATE + ${HDF5_F90_LIB_TARGET} + ${HDF5_LIB_TARGET} + $<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_LIBRARIES}> + ) + set_target_properties (f90_ex_ph5example PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER examples/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + else () + target_include_directories (f90_ex_ph5example + PRIVATE + "${CMAKE_Fortran_MODULE_DIRECTORY}/shared" + "${HDF5_SRC_DIR}" + "${HDF5_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}" + "${HDF5_F90_BINARY_DIR}/shared" + "$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_INCLUDE_DIRS}>" + ) + target_link_libraries (f90_ex_ph5example + PRIVATE + ${HDF5_F90_LIBSH_TARGET} + ${HDF5_LIBSH_TARGET} + $<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_LIBRARIES}> ) - target_include_directories (f90_ex_ph5example-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (f90_ex_ph5example-shared PROPERTIES + set_target_properties (f90_ex_ph5example PROPERTIES LINKER_LANGUAGE Fortran FOLDER examples/fortran Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared @@ -133,6 +168,6 @@ if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) endif () endif () -if (BUILD_TESTING) +if (BUILD_TESTING AND HDF5_TEST_FORTRAN AND HDF5_TEST_EXAMPLES) include (CMakeTests.cmake) endif () diff --git a/fortran/examples/CMakeTests.cmake b/fortran/examples/CMakeTests.cmake index 3403571..a52375b 100644 --- a/fortran/examples/CMakeTests.cmake +++ b/fortran/examples/CMakeTests.cmake @@ -16,105 +16,61 @@ ############################################################################## ############################################################################## +if (HDF5_TEST_SERIAL) + set (test_ex_fortran_CLEANFILES + compound.h5 + copy1.h5 + copy2.h5 + dsetf.h5 + extend.h5 + FORTRAN.h5 + groupf.h5 + groupsf.h5 + h5_cmprss.h5 + mount1.h5 + mount2.h5 + sdsf.h5 + subset.h5 + SDScompound.h5 + test.h5 + ) + # Remove any output file left over from previous test run add_test ( NAME f90_ex-clear-objects - COMMAND ${CMAKE_COMMAND} - -E remove - compound.h5 - copy1.h5 - copy2.h5 - dsetf.h5 - extend.h5 - FORTRAN.h5 - groupf.h5 - groupsf.h5 - h5_cmprss.h5 - mount1.h5 - mount2.h5 - sdsf.h5 - subset.h5 - SDScompound.h5 - test.h5 + COMMAND ${CMAKE_COMMAND} -E remove ${test_ex_fortran_CLEANFILES} ) - if (NOT "${last_test}" STREQUAL "") - set_tests_properties (f90_ex-clear-objects PROPERTIES DEPENDS ${last_test}) - endif () - set (last_test "f90_ex-clear-objects") - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_test ( - NAME f90_ex-shared-clear-objects - COMMAND ${CMAKE_COMMAND} - -E remove - compound.h5 - copy1.h5 - copy2.h5 - dsetf.h5 - extend.h5 - FORTRAN.h5 - groupf.h5 - groupsf.h5 - h5_cmprss.h5 - mount1.h5 - mount2.h5 - sdsf.h5 - subset.h5 - SDScompound.h5 - test.h5 - ) - if (NOT "${last_test}" STREQUAL "") - set_tests_properties (f90_ex-shared-clear-objects PROPERTIES DEPENDS ${last_test}) - endif () - set (last_test "f90_ex-shared-clear-objects") - endif () + set_tests_properties (f90_ex-clear-objects PROPERTIES FIXTURES_SETUP clear_f90_ex) -foreach (example ${examples}) - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME f90_ex_${example} COMMAND $<TARGET_FILE:f90_ex_${example}>) - else () - add_test (NAME f90_ex_${example} COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:f90_ex_${example}>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_OUTPUT=f90_ex_${example}.txt" - #-D "TEST_REFERENCE=f90_ex_${example}.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () - if (NOT "${last_test}" STREQUAL "") - set_tests_properties (f90_ex_${example} PROPERTIES DEPENDS ${last_test}) - endif () - set (last_test "f90_ex_${example}") - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) + foreach (example ${examples}) if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME f90_ex-shared_${example} COMMAND $<TARGET_FILE:f90_ex_${example}-shared>) + add_test (NAME f90_ex_${example} COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:f90_ex_${example}>) else () - add_test (NAME f90_ex-shared_${example} COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:f90_ex_${example}-shared>" + add_test (NAME f90_ex_${example} COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" + -D "TEST_PROGRAM=$<TARGET_FILE:f90_ex_${example}>" -D "TEST_ARGS:STRING=" -D "TEST_EXPECT=0" -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_OUTPUT=f90_ex_${example}-shared.txt" - #-D "TEST_REFERENCE=f90_ex_${example}-shared.out" + -D "TEST_OUTPUT=f90_ex_${example}.txt" + #-D "TEST_REFERENCE=f90_ex_${example}.out" -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" ) endif () - if (NOT "${last_test}" STREQUAL "") - set_tests_properties (f90_ex-shared_${example} PROPERTIES DEPENDS ${last_test}) + set_tests_properties (f90_ex_${example} PROPERTIES FIXTURES_REQUIRED clear_f90_ex) + if (last_test) + set_tests_properties (f90_ex_${example} PROPERTIES DEPENDS ${last_test}) endif () - set (last_test "f90_ex-shared_${example}") - endif () -endforeach () + set (last_test "f90_ex_${example}") + endforeach () -if (HDF5_ENABLE_F2003) foreach (example ${F2003_examples}) if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME f03_ex_${example} COMMAND $<TARGET_FILE:f03_ex_${example}>) + add_test (NAME f03_ex_${example} COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:f03_ex_${example}>) else () add_test (NAME f03_ex_${example} COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" -D "TEST_PROGRAM=$<TARGET_FILE:f03_ex_${example}>" -D "TEST_ARGS:STRING=" -D "TEST_EXPECT=0" @@ -125,36 +81,14 @@ if (HDF5_ENABLE_F2003) -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" ) endif () - if (NOT "${last_test}" STREQUAL "") + set_tests_properties (f03_ex_${example} PROPERTIES FIXTURES_REQUIRED clear_f90_ex) + if (last_test) set_tests_properties (f03_ex_${example} PROPERTIES DEPENDS ${last_test}) endif () set (last_test "f03_ex_${example}") - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME f03_ex-shared_${example} COMMAND $<TARGET_FILE:f03_ex_${example}-shared>) - else () - add_test (NAME f03_ex-shared_${example} COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:f03_ex_${example}-shared>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_OUTPUT=f03_ex_${example}-shared.txt" - #-D "TEST_REFERENCE=f03_ex_${example}-shared.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () - if (NOT "${last_test}" STREQUAL "") - set_tests_properties (f03_ex-shared_${example} PROPERTIES DEPENDS ${last_test}) - endif () - set (last_test "f03_ex-shared_${example}") - endif () endforeach () endif () -if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) - add_test (NAME f90_ex_ph5example COMMAND ${MPIEXEC} ${MPIEXEC_PREFLAGS} ${MPIEXEC_NUMPROC_FLAG} ${MPIEXEC_MAX_NUMPROCS} ${MPIEXEC_POSTFLAGS} $<TARGET_FILE:f90_ex_ph5example>) - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_test (NAME f90_ex-shared_ph5example COMMAND ${MPIEXEC} ${MPIEXEC_PREFLAGS} ${MPIEXEC_NUMPROC_FLAG} ${MPIEXEC_MAX_NUMPROCS} ${MPIEXEC_POSTFLAGS} $<TARGET_FILE:f90_ex_ph5example>) - endif () +if (H5_HAVE_PARALLEL AND HDF5_TEST_PARALLEL AND MPI_Fortran_FOUND) + add_test (NAME MPI_TEST_f90_ex_ph5example COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${MPIEXEC_MAX_NUMPROCS} ${MPIEXEC_PREFLAGS} $<TARGET_FILE:f90_ex_ph5example> ${MPIEXEC_POSTFLAGS}) endif () diff --git a/fortran/examples/Makefile.am b/fortran/examples/Makefile.am index 6bf2edb..474126d 100644 --- a/fortran/examples/Makefile.am +++ b/fortran/examples/Makefile.am @@ -74,8 +74,8 @@ endif # Tell automake how to install examples # Note: no '/' after DESTDIR. Explanation in commence.am -EXAMPLEDIR=${DESTDIR}$(exec_prefix)/share/hdf5_examples/fortran -EXAMPLETOPDIR=${DESTDIR}$(exec_prefix)/share/hdf5_examples +EXAMPLEDIR=${DESTDIR}$(examplesdir)/fortran +EXAMPLETOPDIR=${DESTDIR}$(examplesdir) # List dependencies for each example. Normally, automake would take # care of this for us, but if we tell automake about the programs it diff --git a/fortran/examples/compound_complex_fortran2003.f90 b/fortran/examples/compound_complex_fortran2003.f90 index 6d0f291..9f0cc9f 100644 --- a/fortran/examples/compound_complex_fortran2003.f90 +++ b/fortran/examples/compound_complex_fortran2003.f90 @@ -11,8 +11,8 @@ ! help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! -! This example shows how to create an array of a compound datatype which -! contains an array of type complex and how to write it to hdf5 +! This example shows how to create an array of a compound datatype which +! contains an array of type complex and how to write it to hdf5 ! and how to read it back into a compound datatype for hdf5. ! @@ -85,7 +85,7 @@ PROGRAM compound_complex_fortran2003 ! Open the file and the dataset. ! CALL H5Fopen_f("test.h5", H5F_ACC_RDONLY_F, file_id, error) - + CALL H5Dopen_f(file_id, "samples", dset_id, error) ! ! Create the memory data type. diff --git a/fortran/examples/compound_fortran2003.f90 b/fortran/examples/compound_fortran2003.f90 index 0168177..09e1b04 100644 --- a/fortran/examples/compound_fortran2003.f90 +++ b/fortran/examples/compound_fortran2003.f90 @@ -77,10 +77,10 @@ PROGRAM main INTEGER(SIZE_T) :: offset, sizeof_compound INTEGER :: hdferr TYPE(C_PTR) :: f_ptr - - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double datatype + + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double datatype INTEGER(hid_t) :: tid3 ! /* Nested Array Datatype ID */ INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/13/) ! @@ -133,7 +133,7 @@ PROGRAM main ! ! Write data to the dataset ! - + f_ptr = C_LOC(s1(1)) CALL H5Dwrite_f(dataset, s1_tid, f_ptr, hdferr) @@ -150,7 +150,7 @@ PROGRAM main ! CALL H5Fopen_f(H5FILE_NAME, H5F_ACC_RDONLY_F, file, hdferr) - + CALL H5Dopen_f(file, DATASETNAME, dataset,hdferr) ! diff --git a/fortran/examples/h5_cmprss.f90 b/fortran/examples/h5_cmprss.f90 index 61dd7b0..f543024 100644 --- a/fortran/examples/h5_cmprss.f90 +++ b/fortran/examples/h5_cmprss.f90 @@ -10,17 +10,17 @@ ! If you do not have access to either file, you may request a copy from * ! help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! +! ! This example illustrates how to create a compressed dataset. ! It is used in the HDF5 Tutorial. -! +! PROGRAM h5_cmprss - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE ! - ! The dataset is stored in file "h5_cmprss.h5" + ! The dataset is stored in file "h5_cmprss.h5" ! CHARACTER(LEN=12), PARAMETER :: filename = "h5_cmprss.h5" INTEGER, PARAMETER :: rank = 2 ! Rank of the data set @@ -33,7 +33,7 @@ PROGRAM h5_cmprss INTEGER :: error INTEGER(hsize_t), DIMENSION(1:rank) :: dims ! dimensions of data INTEGER(hsize_t), DIMENSION(1:rank) :: cdims ! sizes of chunked data - + INTEGER :: i,j, numfilt INTEGER, DIMENSION(1:dim0,1:dim1) :: buf ! write buffer INTEGER, DIMENSION(1:dim0,1:dim1) :: rbuf ! read buffer @@ -63,15 +63,15 @@ PROGRAM h5_cmprss CALL h5screate_simple_f(rank, dims, dataspace_id, error) CALL h5pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) ! - ! Dataset must be chunked for compression + ! Dataset must be chunked for compression cdims(1:2) = 20 CALL h5pset_chunk_f(plist_id, 2, cdims, error) ! Set ZLIB / DEFLATE Compression using compression level 6. - ! To use SZIP Compression comment out these lines. + ! To use SZIP Compression comment out these lines. CALL h5pset_deflate_f(plist_id, 6, error) - ! Uncomment these lines to set SZIP Compression + ! Uncomment these lines to set SZIP Compression !szip_options_mask = H5_SZIP_NN_OM_F !szip_pixels_per_block = 16 !CALL H5Pset_szip_f(plist_id, szip_options_mask, szip_pixels_per_block, error) @@ -86,7 +86,7 @@ PROGRAM h5_cmprss ENDDO ENDDO - data_dims(1:2) = (/dim0,dim1/) + data_dims(1:2) = (/dim0,dim1/) CALL h5dwrite_f(dataset_id, H5T_NATIVE_INTEGER, buf, data_dims, error) ! Close resources @@ -99,12 +99,12 @@ PROGRAM h5_cmprss CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file_id, error) CALL h5dopen_f(file_id, "Compressed_Data", dataset_id, error) - ! Retrieve filter information. + ! Retrieve filter information. CALL h5dget_create_plist_f(dataset_id, plist_id, error) - + CALL h5pget_nfilters_f(plist_id, numfilt, error) WRITE(*,'(A, I0)') "Number of filters associated with dataset: ", numfilt - + DO i = 1, numfilt nelmts = 1 CALL h5pget_filter_f(plist_id, 0, flags, nelmts, cd_values, & @@ -121,7 +121,7 @@ PROGRAM h5_cmprss ENDDO data_dims(1:2) = (/dim0,dim1/) CALL h5dread_f(dataset_id, H5T_NATIVE_INTEGER, rbuf, data_dims, error) - + CALL h5dclose_f(dataset_id, error) CALL h5pclose_f(plist_id, error) CALL h5fclose_f(file_id, error) diff --git a/fortran/examples/h5_crtatt.f90 b/fortran/examples/h5_crtatt.f90 index 7e287c6..d3df380 100644 --- a/fortran/examples/h5_crtatt.f90 +++ b/fortran/examples/h5_crtatt.f90 @@ -84,6 +84,10 @@ PROGRAM H5_CRTATT ! CALL h5aclose_f(attr_id, error) ! + ! Close the attribute datatype. + ! + CALL h5tclose_f(atype_id, error) + ! ! Terminate access to the data space. ! CALL h5sclose_f(aspace_id, error) diff --git a/fortran/examples/h5_extend.f90 b/fortran/examples/h5_extend.f90 index 20b91ff..93bfea8 100644 --- a/fortran/examples/h5_extend.f90 +++ b/fortran/examples/h5_extend.f90 @@ -15,12 +15,12 @@ PROGRAM H5_EXTEND - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE ! - !the dataset is stored in file "extend.h5" + !the dataset is stored in file "extend.h5" ! CHARACTER(LEN=9), PARAMETER :: filename = "extend.h5" @@ -30,11 +30,11 @@ PROGRAM H5_EXTEND CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray" INTEGER :: RANK = 2 - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier - INTEGER(HID_T) :: memspace ! Memory dataspace identifier - INTEGER(HID_T) :: crp_list ! Dataset creation property identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! Memory dataspace identifier + INTEGER(HID_T) :: crp_list ! Dataset creation property identifier ! !dataset dimensions at creation time @@ -42,7 +42,7 @@ PROGRAM H5_EXTEND INTEGER(HSIZE_T), DIMENSION(1:2) :: dims = (/3,3/) ! - !data dimensions + !data dimensions ! INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsc = (/2,5/) INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsm = (/3,7/) @@ -50,49 +50,49 @@ PROGRAM H5_EXTEND ! !Maximum dimensions ! - INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims + INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims INTEGER(HSIZE_T), DIMENSION(1:2) :: offset - INTEGER(HSIZE_T), DIMENSION(1:2) :: count + INTEGER(HSIZE_T), DIMENSION(1:2) :: count ! - ! Variables for reading and writing + ! Variables for reading and writing ! - INTEGER, DIMENSION(1:3,1:3) :: data1 + INTEGER, DIMENSION(1:3,1:3) :: data1 INTEGER, DIMENSION(1:21) :: data2 = & (/2, 3, 4, 2, 3, 4, 2, 3, 4, 2, 3, 4, 2, 3, 4, 2, 3, 4, 2, 3, 4/) INTEGER(HSIZE_T), DIMENSION(1:2) :: data_dims ! - !Size of data in the file + !Size of data in the file ! INTEGER(HSIZE_T), DIMENSION(1:2) :: size ! - !general purpose integer + !general purpose integer ! INTEGER(HSIZE_T) :: i, j ! - !flag to check operation success + !flag to check operation success ! - INTEGER :: error + INTEGER :: error ! !Variables used in reading data back - ! + ! INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsr, maxdimsr INTEGER :: rankr - INTEGER, DIMENSION(1:3,1:10) :: rdata + INTEGER, DIMENSION(1:3,1:10) :: rdata ! !Initialize FORTRAN predifined datatypes ! - CALL h5open_f(error) + CALL h5open_f(error) ! !Create a new file using default properties. - ! + ! CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) ! @@ -117,7 +117,7 @@ PROGRAM H5_EXTEND CALL h5sclose_f(dataspace, error) ! - !Fill data array with 1's + !Fill data array with 1's ! DO i = 1, dims(1) DO j = 1, dims(2) @@ -128,7 +128,7 @@ PROGRAM H5_EXTEND ! !Write data array to dataset ! - data_dims(1:2) = (/3,3/) + data_dims(1:2) = (/3,3/) CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data1, data_dims, error) ! @@ -144,7 +144,7 @@ PROGRAM H5_EXTEND ! !Write to 3x7 extended part of dataset - ! + ! CALL h5dget_space_f(dset_id, dataspace, error) CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & offset, count, error) @@ -185,7 +185,7 @@ PROGRAM H5_EXTEND ! !Get dataspace's dimensions. - ! + ! CALL h5sget_simple_extent_dims_f(dataspace, dimsr, maxdimsr, error) ! @@ -204,15 +204,15 @@ PROGRAM H5_EXTEND CALL h5screate_simple_f(rankr, dimsr, memspace, error) ! - !Read data + !Read data ! data_dims(1:2) = (/3,10/) CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, data_dims, & error, memspace, dataspace) - WRITE(*,'(A)') "Dataset:" + WRITE(*,'(A)') "Dataset:" DO i = 1, dimsr(1) - WRITE(*,'(100(I0,1X))') rdata(i,1:dimsr(2)) + WRITE(*,'(100(I0,1X))') rdata(i,1:dimsr(2)) END DO ! diff --git a/fortran/examples/h5_subset.f90 b/fortran/examples/h5_subset.f90 index ab33c86..9bebce5 100644 --- a/fortran/examples/h5_subset.f90 +++ b/fortran/examples/h5_subset.f90 @@ -11,23 +11,23 @@ ! help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! -! This example shows how to write and read a hyperslab. +! This example shows how to write and read a hyperslab. ! It is used in the HDF5 Tutorial. ! -PROGRAM H5_SUBSET +PROGRAM H5_SUBSET - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE CHARACTER(LEN=9), PARAMETER :: filename = "subset.h5" ! File name CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier - INTEGER(HID_T) :: memspace ! memspace identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier ! ! To change the subset size, modify size of dimsm, sdata, dim0_sub, @@ -35,57 +35,57 @@ PROGRAM H5_SUBSET ! INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsm = (/4,3/) ! Dataset dimensions INTEGER, DIMENSION(1:4,1:3) :: sdata ! Subset buffer - INTEGER :: dim0_sub = 4 - INTEGER :: dim1_sub = 3 + INTEGER :: dim0_sub = 4 + INTEGER :: dim1_sub = 3 INTEGER(HSIZE_T), DIMENSION(1:2) :: count = (/4,3/) ! Size of hyperslab INTEGER(HSIZE_T), DIMENSION(1:2) :: offset = (/2,1/) ! Hyperslab offset - INTEGER(HSIZE_T), DIMENSION(1:2) :: stride = (/1,1/) ! Hyperslab stride - INTEGER(HSIZE_T), DIMENSION(1:2) :: block = (/1,1/) ! Hyperslab block size + INTEGER(HSIZE_T), DIMENSION(1:2) :: stride = (/1,1/) ! Hyperslab stride + INTEGER(HSIZE_T), DIMENSION(1:2) :: block = (/1,1/) ! Hyperslab block size INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsf = (/10,8/) ! Dataset dimensions INTEGER, DIMENSION(1:10,1:8) :: data ! Data to write - INTEGER, DIMENSION(1:10,1:8) :: rdata ! Data to read + INTEGER, DIMENSION(1:10,1:8) :: rdata ! Data to read INTEGER :: rank = 2 ! Dataset rank ( in file ) INTEGER :: dim0 = 10 ! Dataset size in file - INTEGER :: dim1 = 8 + INTEGER :: dim1 = 8 - INTEGER :: i, j + INTEGER :: i, j INTEGER :: error ! Error flag INTEGER(HSIZE_T), DIMENSION(2) :: data_dims ! - ! Write data to the HDF5 file. + ! Write data to the HDF5 file. ! ! - ! Data initialization. + ! Data initialization. ! - DO i = 1, dim0 + DO i = 1, dim0 DO j = 1, dim1 IF (i .LE. (dim0 / 2)) THEN - data(i,j) = 1 - ELSE - data(i,j) = 2 + data(i,j) = 1 + ELSE + data(i,j) = 2 END IF END DO END DO ! - ! Initialize FORTRAN interface. + ! Initialize FORTRAN interface. ! - CALL h5open_f(error) + CALL h5open_f(error) ! ! Create a new file using default properties. - ! + ! CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) ! - ! Create the data space for the dataset. + ! Create the data space for the dataset. ! CALL h5screate_simple_f(rank, dimsf, dataspace, error) @@ -98,12 +98,12 @@ PROGRAM H5_SUBSET ! ! Write the dataset. ! - data_dims(1) = dim0 - data_dims(2) = dim1 + data_dims(1) = dim0 + data_dims(2) = dim1 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) ! - ! Data Written to File + ! Data Written to File ! WRITE(*,'(/,A)') "Original Data Written to File:" DO i = 1, dim0 @@ -138,7 +138,7 @@ PROGRAM H5_SUBSET ! CALL h5dget_space_f(dset_id, dataspace, error) CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & - offset, count, error, stride, BLOCK) + offset, count, error, stride, BLOCK) ! ! Create memory dataspace. ! @@ -148,9 +148,9 @@ PROGRAM H5_SUBSET WRITE(*,'(A,/)') " offset=2x1 stride=1x1 count=4x3 block=1x1" ! - ! Write subset to dataset + ! Write subset to dataset ! - data_dims(1:2) = (/dim0_sub, dim1_sub/) + data_dims(1:2) = (/dim0_sub, dim1_sub/) CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, sdata, data_dims, error, & memspace, dataspace) @@ -158,10 +158,10 @@ PROGRAM H5_SUBSET CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, data_dims, error) ! - ! Read entire dataset back + ! Read entire dataset back ! WRITE(*,'(A)') "Data in File after Subset Written:" - DO i = 1, dim0 + DO i = 1, dim0 WRITE(*,'(100(1X,I0,1X))') rdata(i,1:dim1) END DO PRINT *, " " diff --git a/fortran/examples/nested_derived_type.f90 b/fortran/examples/nested_derived_type.f90 index 68354ac..651830c 100644 --- a/fortran/examples/nested_derived_type.f90 +++ b/fortran/examples/nested_derived_type.f90 @@ -1,4 +1,4 @@ -! +! ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -82,10 +82,10 @@ PROGRAM main INTEGER(SIZE_T) :: offset, sizeof_compound INTEGER :: hdferr TYPE(C_PTR) :: f_ptr - - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double datatype + + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double datatype INTEGER(hid_t) :: tid3 ! /* Nested Array Datatype ID */ INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/7/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims1a=(/4/) @@ -136,7 +136,7 @@ PROGRAM main ! ! Write data to the dataset ! - + f_ptr = C_LOC(s1(1)) CALL H5Dwrite_f(dataset, s1_tid, f_ptr, hdferr) @@ -153,7 +153,7 @@ PROGRAM main ! CALL H5Fopen_f(H5FILE_NAME, H5F_ACC_RDONLY_F, file, hdferr) - + CALL H5Dopen_f(file, DATASETNAME, dataset,hdferr) ! ! Create a data type for s2 diff --git a/fortran/examples/run-fortran-ex.sh.in b/fortran/examples/run-fortran-ex.sh.in index cace1ae..81e54ea 100644 --- a/fortran/examples/run-fortran-ex.sh.in +++ b/fortran/examples/run-fortran-ex.sh.in @@ -18,7 +18,7 @@ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # This script will compile and run the fortran examples from source files # -# installed in .../share/hdf5_examples/fortran using h5fc or h5pfc. The # +# installed in @examplesdir@/fortran using h5fc or h5pfc. The # # order for running programs with RunTest in the MAIN section below is taken # # from the Makefile. The order is important since some of the test programs # # use data files created by earlier test programs. Any future additions should # @@ -30,9 +30,32 @@ EXIT_SUCCESS=0 EXIT_FAILURE=1 +# +# Try to derive the path to the installation $prefix established +# by ./configure relative to the examples directory established by +# ./configure. If successful, set `prefix_relto_examplesdir` to the +# relative path. Otherwise, set `prefix_relto_examplesdir` to the +# absolute installation $prefix. +# +# This script uses the value of `prefix` in the user's environment, if +# it is set, below. The content of $() is evaluated in a sub-shell, so +# if `prefix` is set in the user's environment, the shell statements in +# $() won't clobbered it. +# +prefix_relto_examplesdir=$( +prefix=@prefix@ +examplesdir=@examplesdir@ +if [ ${examplesdir##${prefix}/} != ${examplesdir} ]; then + echo $(echo ${examplesdir##${prefix}/} | \ + sed 's,[^/][^/]*,..,g') +else + echo $prefix +fi +) + # Where the tool is installed. # default is relative path to installed location of the tools -prefix="${prefix:-@prefix@}" +prefix="${prefix:-../${prefix_relto_examplesdir}}" PARALLEL=@PARALLEL@ # Am I in parallel mode? AR="@AR@" RANLIB="@RANLIB@" @@ -61,8 +84,6 @@ RunTest() ./$TEST_EXEC } -F2003_ENABLED=@HAVE_FORTRAN_2003@ - ################## MAIN ################## # Run tests @@ -97,17 +118,8 @@ then RunTest mountexample &&\ rm mountexample &&\ RunTest compound &&\ - rm compound); then - EXIT_VALUE=${EXIT_SUCCESS} - else - EXIT_VALUE=${EXIT_FAILURE} - fi -fi - -if [ $EXIT_VALUE -eq ${EXIT_SUCCESS} -a "$F2003_ENABLED" = "yes" ] -then -# Add attention tests for Fortran 2003 features - if (RunTest rwdset_fortran2003 &&\ + rm compound &&\ + RunTest rwdset_fortran2003 &&\ rm rwdset_fortran2003 &&\ RunTest nested_derived_type &&\ rm nested_derived_type &&\ @@ -120,12 +132,11 @@ then EXIT_VALUE=${EXIT_FAILURE} fi fi - # Cleanup rm *.o rm *.h5 echo -exit $EXIT_VALUE +exit $EXIT_VALUE diff --git a/fortran/examples/rwdset_fortran2003.f90 b/fortran/examples/rwdset_fortran2003.f90 index 36ebf0d..f79c8fe 100644 --- a/fortran/examples/rwdset_fortran2003.f90 +++ b/fortran/examples/rwdset_fortran2003.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -9,12 +9,12 @@ ! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * ! If you do not have access to either file, you may request a copy from * ! help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! -! The following example shows how to write and read to/from an existing dataset. -! It opens the file created in the previous example, obtains the dataset -! identifier, writes the data to the dataset in the file, +! The following example shows how to write and read to/from an existing dataset. +! It opens the file created in the previous example, obtains the dataset +! identifier, writes the data to the dataset in the file, ! then reads the dataset to memory. Uses updated Fortran 2003 interface ! with different KINDs of integers and reals. ! @@ -22,8 +22,8 @@ PROGRAM RWDSET_FORTRAN2003 USE ISO_C_BINDING - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors @@ -42,13 +42,13 @@ PROGRAM RWDSET_FORTRAN2003 CHARACTER(LEN=6), PARAMETER :: dsetnamer4 = "dsetr4" ! Dataset name CHARACTER(LEN=6), PARAMETER :: dsetnamer8 = "dsetr8" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id1 ! Dataset identifier - INTEGER(HID_T) :: dset_id4 ! Dataset identifier - INTEGER(HID_T) :: dset_id8 ! Dataset identifier - INTEGER(HID_T) :: dset_id16 ! Dataset identifier - INTEGER(HID_T) :: dset_idr4 ! Dataset identifier - INTEGER(HID_T) :: dset_idr8 ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id1 ! Dataset identifier + INTEGER(HID_T) :: dset_id4 ! Dataset identifier + INTEGER(HID_T) :: dset_id8 ! Dataset identifier + INTEGER(HID_T) :: dset_id16 ! Dataset identifier + INTEGER(HID_T) :: dset_idr4 ! Dataset identifier + INTEGER(HID_T) :: dset_idr8 ! Dataset identifier INTEGER :: error ! Error flag INTEGER :: i @@ -65,15 +65,15 @@ PROGRAM RWDSET_FORTRAN2003 REAL(real_kind_7), DIMENSION(1:4), TARGET :: dset_data_r7, data_out_r7 REAL(real_kind_15), DIMENSION(1:4), TARGET :: dset_data_r15, data_out_r15 - INTEGER(HSIZE_T), DIMENSION(1:1) :: data_dims = (/4/) + INTEGER(HSIZE_T), DIMENSION(1:1) :: data_dims = (/4/) INTEGER(HID_T) :: dspace_id ! Dataspace identifier - + TYPE(C_PTR) :: f_ptr ! ! Initialize FORTRAN interface. ! - CALL h5open_f(error) + CALL h5open_f(error) ! ! Initialize the dset_data array. ! @@ -130,7 +130,7 @@ PROGRAM RWDSET_FORTRAN2003 ! ! Read the dataset. ! - ! Read data back into an integer size that is larger then the original size used for + ! Read data back into an integer size that is larger then the original size used for ! writing the data f_ptr = C_LOC(data_out_i8a(1)) CALL h5dread_f(dset_id1, h5kind_to_type(int_kind_8,H5_INTEGER_KIND), f_ptr, error) @@ -172,5 +172,5 @@ PROGRAM RWDSET_FORTRAN2003 END PROGRAM RWDSET_FORTRAN2003 - + diff --git a/fortran/examples/testh5fc.sh.in b/fortran/examples/testh5fc.sh.in index f384909..200f311 100644 --- a/fortran/examples/testh5fc.sh.in +++ b/fortran/examples/testh5fc.sh.in @@ -71,13 +71,13 @@ temp_FILES="a.out $applib" # An application Main that calls hdf5 and application's own functions. cat > $appmain <<EOF PROGRAM FILEEXAMPLE - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE CHARACTER(LEN=8), PARAMETER :: filename = "apptmp.h5" ! File name INTEGER(HID_T) :: file_id ! File identifier - + INTEGER :: error ! Error flag CALL sub1 @@ -86,7 +86,7 @@ cat > $appmain <<EOF CALL h5fclose_f(file_id, error) CALL h5close_f(error) CALL sub2 - END PROGRAM FILEEXAMPLE + END PROGRAM FILEEXAMPLE EOF # generate prog1 @@ -107,20 +107,20 @@ EOF # An HDF5 sample program that calls hdf5 functions. cat > $hdf5main <<EOF PROGRAM FILEEXAMPLE - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE CHARACTER(LEN=8), PARAMETER :: filename = "apptmp.h5" ! File name INTEGER(HID_T) :: file_id ! File identifier - + INTEGER :: error ! Error flag CALL h5open_f (error) CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) CALL h5fclose_f(file_id, error) CALL h5close_f(error) - END PROGRAM FILEEXAMPLE + END PROGRAM FILEEXAMPLE EOF diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index 6d51feb..bf2fd84 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -1,5 +1,5 @@ -cmake_minimum_required (VERSION 3.2.2) -PROJECT (HDF5_F90_SRC C CXX Fortran) +cmake_minimum_required (VERSION 3.12) +project (HDF5_F90_SRC C Fortran) #----------------------------------------------------------------------------- # configure def file for shared libs on windows @@ -9,11 +9,7 @@ if (WIN32) if (NOT H5_HAVE_PARALLEL) set (H5_NOPAREXP ";") endif () - if (NOT HDF5_ENABLE_F2003) - set (H5_NOF03EXP ";") - else () - set (H5_F03EXP ";") - endif () + set (H5_F03EXP ";") configure_file (${HDF5_F90_SRC_SOURCE_DIR}/hdf5_fortrandll.def.in ${HDF5_F90_SRC_BINARY_DIR}/hdf5_fortrandll.def @ONLY) endif () endif () @@ -32,8 +28,8 @@ if (HAVE_FLOAT128) set (CMAKE_H5_HAVE_FLOAT128 1) endif () -configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5config_f.inc.cmake ${CMAKE_BINARY_DIR}/H5config_f.inc @ONLY) -configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5fort_type_defines.h.in ${HDF5_F90_BINARY_DIR}/H5fort_type_defines.h @ONLY) +configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5config_f.inc.cmake ${HDF5_F90_BINARY_DIR}/H5config_f.inc @ONLY) +configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5fort_type_defines.h.cmake ${HDF5_F90_BINARY_DIR}/H5fort_type_defines.h @ONLY) set (Fortran_COMPILER_ID CMAKE_Fortran_COMPILER_ID) @@ -43,58 +39,76 @@ set (Fortran_COMPILER_ID CMAKE_Fortran_COMPILER_ID) # H5fort_type_defines.h used to generate H5f90i_gen.h + H5fortran_types.F90 #----------------------------------------------------------------------------- -add_executable (H5_buildiface - ${HDF5_F90_SRC_SOURCE_DIR}/H5_buildiface.F90 - ) +add_executable (H5_buildiface ${HDF5_F90_SRC_SOURCE_DIR}/H5_buildiface.F90) +target_include_directories (H5_buildiface PRIVATE "${HDF5_BINARY_DIR};${HDF5_F90_BINARY_DIR}") +#if (BUILD_SHARED_LIBS) +# target_compile_definitions(H5_buildiface PRIVATE $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:/MT>) +#endif () +if(MSVC) + set_property(TARGET H5_buildiface PROPERTY COMPILE_FLAGS "/MT") +endif() +#set_property(TARGET H5_buildiface APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +if(MSVC) + set_property(TARGET H5_buildiface PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE") +endif() -if (WIN32 AND MSVC) - if (BUILD_SHARED_LIBS) - set_target_properties (H5_buildiface - PROPERTIES - COMPILE_FLAGS "/MT" - ) - endif () - set_target_properties (H5_buildiface - PROPERTIES - LINK_FLAGS "/SUBSYSTEM:CONSOLE" - ) -endif () set_target_properties (H5_buildiface PROPERTIES LINKER_LANGUAGE Fortran Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} ) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) +if (BUILD_SHARED_LIBS) file (MAKE_DIRECTORY "${HDF5_F90_BINARY_DIR}/shared") - if (WIN32) - set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared/${CMAKE_BUILD_TYPE}) - else () - set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - endif () + set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared/${HDF_CFG_BUILD_TYPE}) endif () -if (WIN32) - set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static/${CMAKE_BUILD_TYPE}) -else () - set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +if (NOT ONLY_SHARED_LIBS) + file (MAKE_DIRECTORY "${HDF5_F90_BINARY_DIR}/static") + set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static/${HDF_CFG_BUILD_TYPE}) endif () -INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${CMAKE_Fortran_MODULE_DIRECTORY}) - #----------------------------------------------------------------------------- add_executable (H5match_types ${HDF5_F90_BINARY_DIR}/H5fort_type_defines.h ${HDF5_F90_SRC_SOURCE_DIR}/H5match_types.c ) -set (CMD $<TARGET_FILE:H5match_types>) +target_include_directories (H5match_types PRIVATE "${HDF5_BINARY_DIR};${HDF5_SRC_DIR};${HDF5_F90_BINARY_DIR};$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_C_INCLUDE_DIRS}>") + add_custom_command ( OUTPUT ${HDF5_F90_BINARY_DIR}/H5f90i_gen.h ${HDF5_F90_BINARY_DIR}/H5fortran_types.F90 - COMMAND ${CMD} + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:H5match_types> WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR} DEPENDS H5match_types ) -set_source_files_properties (${HDF5_F90_BINARY_DIR}/H5f90i_gen.h PROPERTIES GENERATED TRUE) -set_source_files_properties (${HDF5_F90_BINARY_DIR}/H5fortran_types.F90 PROPERTIES GENERATED TRUE) + +if (NOT ONLY_SHARED_LIBS) + add_custom_command ( + OUTPUT ${HDF5_F90_BINARY_DIR}/static/H5f90i_gen.h + ${HDF5_F90_BINARY_DIR}/static/H5fortran_types.F90 + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5f90i_gen.h" "${HDF5_F90_BINARY_DIR}/static/H5f90i_gen.h" + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5fortran_types.F90" "${HDF5_F90_BINARY_DIR}/static/H5fortran_types.F90" + WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}/static + DEPENDS ${HDF5_F90_BINARY_DIR}/H5f90i_gen.h + ) + set_source_files_properties (${HDF5_F90_BINARY_DIR}/static/H5f90i_gen.h PROPERTIES GENERATED TRUE) + set_source_files_properties (${HDF5_F90_BINARY_DIR}/static/H5fortran_types.F90 PROPERTIES GENERATED TRUE) +endif () +if (BUILD_SHARED_LIBS) + add_custom_command ( + OUTPUT ${HDF5_F90_BINARY_DIR}/shared/H5f90i_gen.h + ${HDF5_F90_BINARY_DIR}/shared/H5fortran_types.F90 + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5f90i_gen.h" "${HDF5_F90_BINARY_DIR}/shared/H5f90i_gen.h" + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5fortran_types.F90" "${HDF5_F90_BINARY_DIR}/shared/H5fortran_types.F90" + WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}/shared + DEPENDS ${HDF5_F90_BINARY_DIR}/H5f90i_gen.h + ) + set_source_files_properties (${HDF5_F90_BINARY_DIR}/shared/H5f90i_gen.h PROPERTIES GENERATED TRUE) + set_source_files_properties (${HDF5_F90_BINARY_DIR}/shared/H5fortran_types.F90 PROPERTIES GENERATED TRUE) +endif () #----------------------------------------------------------------------------- # f90CStub lib @@ -121,33 +135,46 @@ set_source_files_properties (${f90CStub_C_SOURCES} PROPERTIES LANGUAGE C) set (f90CStub_C_HDRS # generated files - ${HDF5_F90_BINARY_DIR}/H5f90i_gen.h + ${HDF5_F90_BINARY_DIR}/static/H5f90i_gen.h ) - -add_library (${HDF5_F90_C_LIB_TARGET} STATIC ${f90CStub_C_SOURCES} ${f90CStub_C_HDRS}) -TARGET_C_PROPERTIES (${HDF5_F90_C_LIB_TARGET} STATIC " " " ") -target_link_libraries (${HDF5_F90_C_LIB_TARGET} ${HDF5_LIB_TARGET} ${LINK_LIBS}) -set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_C_LIB_TARGET}") -H5_SET_LIB_OPTIONS (${HDF5_F90_C_LIB_TARGET} ${HDF5_F90_C_LIB_NAME} STATIC) -set_target_properties (${HDF5_F90_C_LIB_TARGET} PROPERTIES - FOLDER libraries/fortran - LINKER_LANGUAGE C - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" +set (f90CStub_C_SHHDRS + # generated files + ${HDF5_F90_BINARY_DIR}/shared/H5f90i_gen.h ) -set (install_targets ${HDF5_F90_C_LIB_TARGET}) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_library (${HDF5_F90_C_LIBSH_TARGET} SHARED ${f90CStub_C_SOURCES} ${f90CStub_C_HDRS}) - TARGET_C_PROPERTIES (${HDF5_F90_C_LIBSH_TARGET} SHARED " " " ") - target_link_libraries (${HDF5_F90_C_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} ${LINK_SHARED_LIBS}) +if (NOT ONLY_SHARED_LIBS) + add_library (${HDF5_F90_C_LIB_TARGET} STATIC ${f90CStub_C_SOURCES} ${f90CStub_C_HDRS}) + target_include_directories (${HDF5_F90_C_LIB_TARGET} + PRIVATE "${HDF5_SRC_DIR};${HDF5_BINARY_DIR};${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static;$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_C_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + ) + target_compile_options(${HDF5_F90_C_LIB_TARGET} PRIVATE "${HDF5_CMAKE_C_FLAGS}") + TARGET_C_PROPERTIES (${HDF5_F90_C_LIB_TARGET} STATIC) + target_link_libraries (${HDF5_F90_C_LIB_TARGET} PUBLIC ${HDF5_LIB_TARGET}) + set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_C_LIB_TARGET}") + H5_SET_LIB_OPTIONS (${HDF5_F90_C_LIB_TARGET} ${HDF5_F90_C_LIB_NAME} STATIC 0) + set_target_properties (${HDF5_F90_C_LIB_TARGET} PROPERTIES + FOLDER libraries/fortran + LINKER_LANGUAGE C + ) + set (install_targets ${HDF5_F90_C_LIB_TARGET}) +endif () + +if (BUILD_SHARED_LIBS) + add_library (${HDF5_F90_C_LIBSH_TARGET} SHARED ${f90CStub_C_SOURCES} ${f90CStub_C_SHHDRS}) + target_include_directories (${HDF5_F90_C_LIBSH_TARGET} + PRIVATE "${HDF5_SRC_DIR};${HDF5_BINARY_DIR};${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared;$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_C_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + ) + target_compile_options(${HDF5_F90_C_LIBSH_TARGET} PRIVATE "${HDF5_CMAKE_C_FLAGS}") + target_compile_definitions(${HDF5_F90_C_LIBSH_TARGET} PUBLIC "H5_BUILT_AS_DYNAMIC_LIB") + TARGET_C_PROPERTIES (${HDF5_F90_C_LIBSH_TARGET} SHARED) + target_link_libraries (${HDF5_F90_C_LIBSH_TARGET} PUBLIC ${HDF5_LIBSH_TARGET}) set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_C_LIBSH_TARGET}") - H5_SET_LIB_OPTIONS (${HDF5_F90_C_LIBSH_TARGET} ${HDF5_F90_C_LIB_NAME} SHARED ${HDF5_F_PACKAGE_SOVERSION}) + H5_SET_LIB_OPTIONS (${HDF5_F90_C_LIBSH_TARGET} ${HDF5_F90_C_LIB_NAME} SHARED "F") set_target_properties (${HDF5_F90_C_LIBSH_TARGET} PROPERTIES FOLDER libraries/fortran LINKER_LANGUAGE C - COMPILE_DEFINITIONS "H5_BUILT_AS_DYNAMIC_LIB" - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" - INTERFACE_COMPILE_DEFINITIONS H5_BUILT_AS_DYNAMIC_LIB=1 ) set (install_targets ${install_targets} ${HDF5_F90_C_LIBSH_TARGET}) endif () @@ -160,26 +187,35 @@ set (f90_F_GEN_SOURCES ${HDF5_F90_SRC_SOURCE_DIR}/H5Dff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Pff.F90 ) -set (CMD $<TARGET_FILE:H5_buildiface>) add_custom_command ( OUTPUT ${HDF5_F90_BINARY_DIR}/H5_gen.F90 - COMMAND ${CMD} + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:H5_buildiface> WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR} DEPENDS ${f90_F_GEN_SOURCES} COMMENT "Generating the H5_gen.F90 file" ) -add_custom_target (H5gen ALL - DEPENDS ${HDF5_F90_BINARY_DIR}/H5_gen.F90 -) -set_source_files_properties (${HDF5_F90_BINARY_DIR}/H5_gen.F90 PROPERTIES GENERATED TRUE) +if (NOT ONLY_SHARED_LIBS) + add_custom_command ( + OUTPUT ${HDF5_F90_BINARY_DIR}/static/H5_gen.F90 + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5_gen.F90" "${HDF5_F90_BINARY_DIR}/static/H5_gen.F90" + WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}/static + DEPENDS ${HDF5_F90_BINARY_DIR}/H5_gen.F90 + COMMENT "Generating the H5_gen.F90 file" + ) + add_custom_target (H5gen ALL + DEPENDS ${HDF5_F90_BINARY_DIR}/static/H5_gen.F90 + ) + set_source_files_properties (${HDF5_F90_BINARY_DIR}/static/H5_gen.F90 PROPERTIES GENERATED TRUE) +endif () -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - set (CMDSH $<TARGET_FILE:H5_buildiface>) +if (BUILD_SHARED_LIBS) add_custom_command ( OUTPUT ${HDF5_F90_BINARY_DIR}/shared/H5_gen.F90 - COMMAND ${CMDSH} + COMMAND ${CMAKE_COMMAND} + ARGS -E copy_if_different "${HDF5_F90_BINARY_DIR}/H5_gen.F90" "${HDF5_F90_BINARY_DIR}/shared/H5_gen.F90" WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}/shared - DEPENDS ${f90_F_GEN_SOURCES} + DEPENDS ${HDF5_F90_BINARY_DIR}/H5_gen.F90 COMMENT "Generating the H5_gen.F90 shared file" ) add_custom_target (H5genSH ALL @@ -205,25 +241,28 @@ set (f90_F_BASE_SOURCES ${HDF5_F90_SRC_SOURCE_DIR}/H5Rff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Sff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Tff.F90 + ${HDF5_F90_SRC_SOURCE_DIR}/H5VLff.F90 ${HDF5_F90_SRC_SOURCE_DIR}/H5Zff.F90 ) -set (f90_F_SOURCES - # generated file - ${HDF5_F90_BINARY_DIR}/H5fortran_types.F90 +if (NOT ONLY_SHARED_LIBS) + set (f90_F_SOURCES + # generated file + ${HDF5_F90_BINARY_DIR}/static/H5fortran_types.F90 - ${f90_F_BASE_SOURCES} + ${f90_F_BASE_SOURCES} - # generated file - ${HDF5_F90_BINARY_DIR}/H5_gen.F90 + # generated file + ${HDF5_F90_BINARY_DIR}/static/H5_gen.F90 - # normal distribution - ${HDF5_F90_SRC_SOURCE_DIR}/HDF5.F90 -) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) + # normal distribution + ${HDF5_F90_SRC_SOURCE_DIR}/HDF5.F90 + ) +endif () +if (BUILD_SHARED_LIBS) set (f90_F_SOURCES_SHARED # generated file - ${HDF5_F90_BINARY_DIR}/H5fortran_types.F90 + ${HDF5_F90_BINARY_DIR}/shared/H5fortran_types.F90 ${f90_F_BASE_SOURCES} @@ -238,55 +277,71 @@ endif () #----------------------------------------------------------------------------- # Add Main fortran library #----------------------------------------------------------------------------- -add_library (${HDF5_F90_LIB_TARGET} STATIC ${f90_F_SOURCES}) -set (SHARED_LINK_FLAGS " ") -TARGET_FORTRAN_PROPERTIES (${HDF5_F90_LIB_TARGET} STATIC " " " ") -target_link_libraries (${HDF5_F90_LIB_TARGET} ${HDF5_F90_C_LIB_TARGET} ${HDF5_LIB_TARGET}) -if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) - target_link_libraries (${HDF5_F90_LIB_TARGET} ${MPI_Fortran_LIBRARIES}) -endif () -set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_LIB_TARGET}") -H5_SET_LIB_OPTIONS (${HDF5_F90_LIB_TARGET} ${HDF5_F90_LIB_NAME} STATIC) -set_target_properties (${HDF5_F90_LIB_TARGET} PROPERTIES - FOLDER libraries/fortran - LINKER_LANGUAGE Fortran - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static -) -if (WIN32) - set_property (TARGET ${HDF5_F90_LIB_TARGET} - APPEND PROPERTY COMPILE_DEFINITIONS "HDF5F90_WINDOWS" +if (NOT ONLY_SHARED_LIBS) + add_library (${HDF5_F90_LIB_TARGET} STATIC ${f90_F_SOURCES}) + target_include_directories (${HDF5_F90_LIB_TARGET} + PRIVATE "${HDF5_F90_SRC_SOURCE_DIR};${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include/static>" ) + target_compile_options(${HDF5_F90_LIB_TARGET} PRIVATE "${HDF5_CMAKE_Fortran_FLAGS}") + target_compile_definitions(${HDF5_F90_LIB_TARGET} + PRIVATE + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:HDF5F90_WINDOWS> + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> + ) + target_link_libraries (${HDF5_F90_LIB_TARGET} + PUBLIC ${HDF5_F90_C_LIB_TARGET} + PRIVATE + ${LINK_Fortran_LIBS} + $<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_LIBRARIES}> + ) +# set_property(TARGET ${HDF5_F90_LIB_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET ${HDF5_F90_LIB_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) + if(MSVC) + set_property(TARGET ${HDF5_F90_LIB_TARGET} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") + endif() + set_target_properties (${HDF5_F90_LIB_TARGET} PROPERTIES + FOLDER libraries/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + H5_SET_LIB_OPTIONS (${HDF5_F90_LIB_TARGET} ${HDF5_F90_LIB_NAME} STATIC 0) + set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_LIB_TARGET}") + set (install_targets ${install_targets} ${HDF5_F90_LIB_TARGET}) + add_dependencies(${HDF5_F90_LIB_TARGET} H5gen) endif () -set (install_targets ${install_targets} ${HDF5_F90_LIB_TARGET}) -add_dependencies(${HDF5_F90_LIB_TARGET} H5gen) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) +if (BUILD_SHARED_LIBS) add_library (${HDF5_F90_LIBSH_TARGET} SHARED ${f90_F_SOURCES_SHARED}) - set (SHARED_LINK_FLAGS " ") - if (WIN32 AND MSVC) - set (SHARED_LINK_FLAGS "/DLL /DEF:${HDF5_F90_SRC_BINARY_DIR}/hdf5_fortrandll.def") - endif () - TARGET_FORTRAN_PROPERTIES (${HDF5_F90_LIBSH_TARGET} SHARED " " ${SHARED_LINK_FLAGS}) - target_link_libraries (${HDF5_F90_LIBSH_TARGET} ${HDF5_F90_C_LIBSH_TARGET} ${HDF5_LIBSH_TARGET}) - if (H5_HAVE_PARALLEL AND MPI_Fortran_FOUND) - target_link_libraries (${HDF5_F90_LIBSH_TARGET} ${MPI_Fortran_LIBRARIES}) - endif () - set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_LIBSH_TARGET}") - H5_SET_LIB_OPTIONS (${HDF5_F90_LIBSH_TARGET} ${HDF5_F90_LIB_NAME} SHARED ${HDF5_F_PACKAGE_SOVERSION}) + target_include_directories (${HDF5_F90_LIBSH_TARGET} + PRIVATE "${HDF5_F90_SRC_SOURCE_DIR};${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include/shared>" + ) + target_compile_options(${HDF5_F90_LIBSH_TARGET} PRIVATE "${HDF5_CMAKE_Fortran_FLAGS}") + target_compile_definitions(${HDF5_F90_LIBSH_TARGET} + PUBLIC "H5_BUILT_AS_DYNAMIC_LIB" + PRIVATE + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:BUILD_HDF5_DLL;HDF5F90_WINDOWS> + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> + ) + target_link_libraries (${HDF5_F90_LIBSH_TARGET} + PUBLIC ${HDF5_F90_C_LIBSH_TARGET} + PRIVATE ${LINK_Fortran_LIBS} $<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_Fortran_LIBRARIES}> + ) +# set_property(TARGET ${HDF5_F90_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET ${HDF5_F90_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +# set_property(TARGET ${HDF5_F90_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-DLL">) +# set_property(TARGET ${HDF5_F90_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-DEF:${HDF5_F90_SRC_BINARY_DIR}/hdf5_fortrandll.def">) + if(MSVC) + set_property(TARGET ${HDF5_F90_LIBSH_TARGET} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS} /DLL /DEF:${HDF5_F90_SRC_BINARY_DIR}/hdf5_fortrandll.def") + endif() set_target_properties (${HDF5_F90_LIBSH_TARGET} PROPERTIES FOLDER libraries/fortran LINKER_LANGUAGE Fortran - COMPILE_DEFINITIONS "H5_BUILT_AS_DYNAMIC_LIB" - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" - INTERFACE_COMPILE_DEFINITIONS H5_BUILT_AS_DYNAMIC_LIB=1 Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - if (WIN32) - set_property (TARGET ${HDF5_F90_LIBSH_TARGET} - APPEND PROPERTY COMPILE_DEFINITIONS "BUILD_HDF5_DLL;HDF5F90_WINDOWS" - ) - endif () + set_global_variable (HDF5_LIBRARIES_TO_EXPORT "${HDF5_LIBRARIES_TO_EXPORT};${HDF5_F90_LIBSH_TARGET}") + H5_SET_LIB_OPTIONS (${HDF5_F90_LIBSH_TARGET} ${HDF5_F90_LIB_NAME} SHARED "F") set (install_targets ${install_targets} ${HDF5_F90_LIBSH_TARGET}) add_dependencies(${HDF5_F90_LIBSH_TARGET} H5genSH) endif () @@ -299,45 +354,67 @@ install ( ${HDF5_F90_SRC_SOURCE_DIR}/H5f90.h ${HDF5_F90_SRC_SOURCE_DIR}/H5f90i.h ${HDF5_F90_SRC_SOURCE_DIR}/H5f90proto.h - ${HDF5_F90_BINARY_DIR}/H5f90i_gen.h - ${HDF5_F90_BINARY_DIR}/H5fortran_types.F90 DESTINATION ${HDF5_INSTALL_INCLUDE_DIR} COMPONENT fortheaders ) +if (NOT ONLY_SHARED_LIBS) + install ( + FILES + ${HDF5_F90_BINARY_DIR}/static/H5f90i_gen.h + ${HDF5_F90_BINARY_DIR}/static/H5fortran_types.F90 + DESTINATION + ${HDF5_INSTALL_INCLUDE_DIR} + COMPONENT + fortheaders + ) +else () + install ( + FILES + ${HDF5_F90_BINARY_DIR}/shared/H5f90i_gen.h + ${HDF5_F90_BINARY_DIR}/shared/H5fortran_types.F90 + DESTINATION + ${HDF5_INSTALL_INCLUDE_DIR} + COMPONENT + fortheaders + ) +endif () -set (mod_files - ${MOD_BUILD_DIR}/h5fortran_types.mod - ${MOD_BUILD_DIR}/hdf5.mod - ${MOD_BUILD_DIR}/h5fortkit.mod - ${MOD_BUILD_DIR}/h5global.mod - ${MOD_BUILD_DIR}/h5a.mod - ${MOD_BUILD_DIR}/h5d.mod - ${MOD_BUILD_DIR}/h5e.mod - ${MOD_BUILD_DIR}/h5f.mod - ${MOD_BUILD_DIR}/h5g.mod - ${MOD_BUILD_DIR}/h5i.mod - ${MOD_BUILD_DIR}/h5l.mod - ${MOD_BUILD_DIR}/h5lib.mod - ${MOD_BUILD_DIR}/h5o.mod - ${MOD_BUILD_DIR}/h5p.mod - ${MOD_BUILD_DIR}/h5r.mod - ${MOD_BUILD_DIR}/h5s.mod - ${MOD_BUILD_DIR}/h5t.mod - ${MOD_BUILD_DIR}/h5z.mod - ${MOD_BUILD_DIR}/h5_gen.mod -) -install ( - FILES - ${mod_files} - DESTINATION - ${HDF5_INSTALL_INCLUDE_DIR}/static - COMPONENT - fortheaders -) +if (NOT ONLY_SHARED_LIBS) + set (mod_files + ${MOD_BUILD_DIR}/h5fortran_types.mod + ${MOD_BUILD_DIR}/hdf5.mod + ${MOD_BUILD_DIR}/h5fortkit.mod + ${MOD_BUILD_DIR}/h5global.mod + ${MOD_BUILD_DIR}/h5a.mod + ${MOD_BUILD_DIR}/h5d.mod + ${MOD_BUILD_DIR}/h5e.mod + ${MOD_BUILD_DIR}/h5f.mod + ${MOD_BUILD_DIR}/h5g.mod + ${MOD_BUILD_DIR}/h5i.mod + ${MOD_BUILD_DIR}/h5l.mod + ${MOD_BUILD_DIR}/h5lib.mod + ${MOD_BUILD_DIR}/h5o.mod + ${MOD_BUILD_DIR}/h5p.mod + ${MOD_BUILD_DIR}/h5r.mod + ${MOD_BUILD_DIR}/h5s.mod + ${MOD_BUILD_DIR}/h5t.mod + ${MOD_BUILD_DIR}/h5vl.mod + ${MOD_BUILD_DIR}/h5z.mod + ${MOD_BUILD_DIR}/h5_gen.mod + ) + install ( + FILES + ${mod_files} + DESTINATION + ${HDF5_INSTALL_INCLUDE_DIR}/static + COMPONENT + fortheaders + ) +endif () -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) +if (BUILD_SHARED_LIBS) set (modsh_files ${MODSH_BUILD_DIR}/h5fortran_types.mod ${MODSH_BUILD_DIR}/hdf5.mod @@ -356,6 +433,7 @@ if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) ${MODSH_BUILD_DIR}/h5r.mod ${MODSH_BUILD_DIR}/h5s.mod ${MODSH_BUILD_DIR}/h5t.mod + ${MODSH_BUILD_DIR}/h5vl.mod ${MODSH_BUILD_DIR}/h5z.mod ${MODSH_BUILD_DIR}/h5_gen.mod ) @@ -373,12 +451,14 @@ endif () # Add Target(s) to CMake Install for import into other projects #----------------------------------------------------------------------------- if (HDF5_EXPORTED_TARGETS) - if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) + if (BUILD_SHARED_LIBS) INSTALL_TARGET_PDB (${HDF5_F90_C_LIBSH_TARGET} ${HDF5_INSTALL_BIN_DIR} fortlibraries) #INSTALL_TARGET_PDB (${HDF5_F90_LIBSH_TARGET} ${HDF5_INSTALL_BIN_DIR} fortlibraries) endif () - INSTALL_TARGET_PDB (${HDF5_F90_C_LIB_TARGET} ${HDF5_INSTALL_BIN_DIR} fortlibraries) - #INSTALL_TARGET_PDB (${HDF5_F90_LIB_TARGET} ${HDF5_INSTALL_BIN_DIR} fortlibraries) + if (NOT ONLY_SHARED_LIBS) + INSTALL_TARGET_PDB (${HDF5_F90_C_LIB_TARGET} ${HDF5_INSTALL_LIB_DIR} fortlibraries) + #INSTALL_TARGET_PDB (${HDF5_F90_LIB_TARGET} ${HDF5_INSTALL_LIB_DIR} fortlibraries) + endif () install ( TARGETS @@ -392,3 +472,53 @@ if (HDF5_EXPORTED_TARGETS) INCLUDES DESTINATION include ) endif () + +#----------------------------------------------------------------------------- +# Create pkgconfig files +#----------------------------------------------------------------------------- +set (_PKG_CONFIG_PREFIX ${CMAKE_INSTALL_PREFIX}) +set (_PKG_CONFIG_EXEC_PREFIX \${prefix}) +set (_PKG_CONFIG_LIBDIR \${exec_prefix}/lib) +set (_PKG_CONFIG_INCLUDEDIR \${prefix}/include) +set (_PKG_CONFIG_LIBNAME "${HDF5_F90_LIB_CORENAME}") +set (_PKG_CONFIG_VERSION "${HDF5_PACKAGE_VERSION}") + +set (_PKG_CONFIG_LIBS_PRIVATE) + +if (NOT ONLY_SHARED_LIBS) + set (_PKG_CONFIG_LIBS "${_PKG_CONFIG_LIBS} -l${HDF5_F90_LIB_CORENAME}") +endif () +if (BUILD_SHARED_LIBS) + set (_PKG_CONFIG_SH_LIBS "${_PKG_CONFIG_SH_LIBS} -l${HDF5_F90_LIB_CORENAME}") +endif () + +set (_PKG_CONFIG_REQUIRES "${HDF5_LIB_CORENAME}") +set (_PKG_CONFIG_REQUIRES_PRIVATE "${HDF5_LIB_CORENAME}") + +configure_file ( + ${HDF_RESOURCES_DIR}/libhdf5.pc.in + ${HDF5_BINARY_DIR}/CMakeFiles/${HDF5_F90_LIB_CORENAME}-${HDF5_PACKAGE_VERSION}.pc + @ONLY +) +install ( + FILES ${HDF5_BINARY_DIR}/CMakeFiles/${HDF5_F90_LIB_CORENAME}-${HDF5_PACKAGE_VERSION}.pc + DESTINATION ${HDF5_INSTALL_LIB_DIR}/pkgconfig + COMPONENT fortlibraries +) + +if (NOT WIN32 AND NOT MINGW) + set (_PKG_CONFIG_COMPILER ${CMAKE_Fortran_COMPILER}) + configure_file ( + ${HDF_RESOURCES_DIR}/libh5cc.in + ${HDF5_BINARY_DIR}/CMakeFiles/h5fc + @ONLY + ) + install ( + FILES ${HDF5_BINARY_DIR}/CMakeFiles/h5fc + DESTINATION ${HDF5_INSTALL_BIN_DIR} + PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE + COMPONENT fortlibraries + ) +endif () + + diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c index 23dd936..5e5bcc0 100644 --- a/fortran/src/H5Af.c +++ b/fortran/src/H5Af.c @@ -137,13 +137,13 @@ int_f h5aget_num_attrs_c (hid_t_f *obj_id, int_f *attr_num) /******/ { - H5O_info_t oinfo; /* Object info */ + H5O_info2_t oinfo; /* Object info */ int_f ret_value = 0; /* Return value */ /* * Call H5Oget_info function. */ - if(H5Oget_info((hid_t)*obj_id, &oinfo) < 0) + if(H5Oget_info3((hid_t)*obj_id, &oinfo, H5O_INFO_NUM_ATTRS) < 0) HGOTO_DONE(FAIL); /* Set number of attributes */ diff --git a/fortran/src/H5Aff.F90 b/fortran/src/H5Aff.F90 index 827b803..f514c37 100644 --- a/fortran/src/H5Aff.F90 +++ b/fortran/src/H5Aff.F90 @@ -72,10 +72,13 @@ MODULE H5A - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_NULL_CHAR, C_LOC, C_INT USE H5GLOBAL + PRIVATE h5awrite_char_scalar, h5awrite_ptr + PRIVATE h5aread_char_scalar, h5aread_ptr + INTERFACE h5awrite_f MODULE PROCEDURE h5awrite_char_scalar ! This is the preferred way to call h5awrite @@ -341,7 +344,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aget_space END INTERFACE - + space_id = H5Aget_space(attr_id) hdferr = 0 @@ -386,7 +389,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aget_type END INTERFACE - + type_id = H5Aget_type(attr_id) hdferr = 0 @@ -505,7 +508,7 @@ CONTAINS ! Returns attribute name size, ! -1 if fail INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list - INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size ! Indicates the size, in the number of characters, + INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size ! Indicates the size, in the number of characters, ! of the attribute !***** INTEGER(HID_T) :: lapl_id_default @@ -1763,7 +1766,7 @@ CONTAINS ! up to 7 dimensions. ! ! Fortran2003 Interface: -!! SUBROUTINE H5Awrite_f(attr_id, memtype_id, buf, hdferr) +!! SUBROUTINE H5Awrite_f(attr_id, memtype_id, buf, hdferr) !! INTEGER(HID_T) , INTENT(IN) :: attr_id !! INTEGER(HID_T) , INTENT(IN) :: memtype_id !! TYPE(C_PTR) , INTENT(IN) :: buf @@ -1848,7 +1851,7 @@ CONTAINS ! REAL, REAL(KIND=C_DOUBLE) and CHARACTER buffers ! up to 7 dimensions. ! Fortran2003 Interface: -!! SUBROUTINE H5Aread_f(attr_id, memtype_id, buf, hdferr) +!! SUBROUTINE H5Aread_f(attr_id, memtype_id, buf, hdferr) !! INTEGER(HID_T) , INTENT(IN) :: attr_id !! INTEGER(HID_T) , INTENT(IN) :: memtype_id !! TYPE(C_PTR) , INTENT(INOUT) :: buf diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index 588ea9f..8ef7936 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -544,7 +544,7 @@ h5dvlen_get_max_len_c ( hid_t_f *dset_id , hid_t_f *type_id, hid_t_f *space_id, c_len = 0; for (i=0; i < num_elem; i++) c_len = H5_MAX(c_len, c_buf[i].len); *len = (size_t_f)c_len; - H5Dvlen_reclaim(c_type_id, c_space_id, H5P_DEFAULT, c_buf); + H5Treclaim(c_type_id, c_space_id, H5P_DEFAULT, c_buf); ret_value = 0; DONE: @@ -567,7 +567,7 @@ DONE: * dims - one-demnsional array of size 2 * dims[0] = MAXLENGTH * dims[1] = number of elements of VL type - * len - array element lenghts + * len - array element lengths * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -641,7 +641,7 @@ DONE: * dims[1] = number of elements of VL type * OUTPUTS * buf - data buffer - * len - array element lenghts + * len - array element lengths * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -690,7 +690,7 @@ h5dread_vl_integer_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_sp len[i] = (size_t_f)c_buf[i].len; memcpy(&buf[i*max_len], c_buf[i].p, c_buf[i].len*sizeof(int_f)); } - H5Dvlen_reclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); + H5Treclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); ret_value = 0; DONE: HDfree(c_buf); @@ -779,7 +779,7 @@ h5dwrite_vl_string_c( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_spa if( status < 0) goto DONE; ret_value = 0; DONE: - H5Dvlen_reclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); + H5Treclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); HDfree(c_buf); HDfree(tmp); return ret_value; @@ -861,7 +861,7 @@ h5dread_vl_string_c( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_spac } HD5packFstring(tmp, _fcdtocp(buf), (size_t)(max_len*num_elem)); ret_value = 0; - H5Dvlen_reclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); + H5Treclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); HDfree(c_buf); HDfree(tmp); return ret_value; @@ -882,7 +882,7 @@ h5dread_vl_string_c( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_spac * dims - one-demnsional array of size 2 * dims[0] = MAXLENGTH * dims[1] = number of elements of VL type - * len - array element lenghts + * len - array element lengths * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -956,7 +956,7 @@ DONE: * dims[1] = number of elements of VL type * OUTPUTS * buf - data buffer - * len - array element lenghts + * len - array element lengths * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -1006,7 +1006,7 @@ h5dread_vl_real_c ( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_space memcpy(&buf[i*max_len], c_buf[i].p, c_buf[i].len*sizeof(real_f)); } - H5Dvlen_reclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); + H5Treclaim(c_mem_type_id, c_mem_space_id, H5P_DEFAULT, c_buf); ret_value = 0; DONE: HDfree(c_buf); @@ -1209,7 +1209,7 @@ h5dwrite_f_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, * dims[1] = number of elements of VL type * OUTPUTS * buf - data buffer - * len - array element lenghts + * len - array element lengths * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -1284,18 +1284,18 @@ h5dget_access_plist_c (hid_t_f *dset_id, hid_t_f *plist_id) * NAME * h5dvlen_reclaim_c * PURPOSE - * Call H5Dvlen_reclaim + * Call H5Treclaim * INPUTS - * type_id - Identifier of the datatype. - * space_id - Identifier of the dataspace. - * plist_id - Identifier of the property list used to create the buffer. - * buf - Pointer to the buffer to be reclaimed. + * type_id - Identifier of the datatype. + * space_id - Identifier of the dataspace. + * plist_id - Identifier of the property list used to create the buffer. + * buf - Pointer to the buffer to be reclaimed. * * RETURNS * 0 on success, -1 on failure * AUTHOR * M. Scot Breitenfeld - * January 15, 2011 + * January 15, 2011 * * SOURCE */ @@ -1307,9 +1307,9 @@ h5dvlen_reclaim_c(hid_t_f *type_id, hid_t_f *space_id, hid_t_f *plist_id, void * herr_t status; /* - * Call H5Dvlen_reclaim function. + * Call H5Treclaim function. */ - status = H5Dvlen_reclaim((hid_t)*type_id, (hid_t)*space_id, (hid_t)*plist_id, buf); + status = H5Treclaim((hid_t)*type_id, (hid_t)*space_id, (hid_t)*plist_id, buf); if ( status < 0 ) return ret_value; ret_value = 0; diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 3915f72..7128698 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -86,10 +86,19 @@ #include <H5config_f.inc> MODULE H5D - - USE, INTRINSIC :: ISO_C_BINDING + + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL + PRIVATE h5dread_vl_integer, h5dread_vl_real, h5dread_vl_string + PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string + PRIVATE h5dwrite_reference_obj, h5dwrite_reference_dsetreg, h5dwrite_char_scalar, h5dwrite_ptr + PRIVATE h5dread_reference_obj, h5dread_reference_dsetreg, h5dread_char_scalar, h5dread_ptr + PRIVATE h5dfill_integer, h5dfill_c_float, h5dfill_c_double, h5dfill_char +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + PRIVATE h5dfill_c_long_double +#endif + INTERFACE h5dextend_f MODULE PROCEDURE h5dset_extent_f END INTERFACE @@ -950,7 +959,7 @@ CONTAINS SUBROUTINE h5dwrite_vl_string(dset_id, mem_type_id, buf, dims, str_len, & hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_char + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_CHAR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1079,7 +1088,7 @@ CONTAINS SUBROUTINE h5dget_offset_f(dset_id, offset, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id - INTEGER(HADDR_T), INTENT(OUT) :: offset + INTEGER(HADDR_T), INTENT(OUT) :: offset INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE @@ -1091,7 +1100,7 @@ CONTAINS END INTERFACE offset = h5dget_offset(dset_id) - + hdferr = 0 ! never returns a function error because C API never returns a function error. END SUBROUTINE h5dget_offset_f @@ -1155,7 +1164,7 @@ CONTAINS ! plist_id - Dataset access property list identifier ! hdferr - Returns 0 if successful and -1 if fails ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! April 13, 2009 ! @@ -1163,8 +1172,8 @@ CONTAINS SUBROUTINE h5dget_access_plist_f(dset_id, plist_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id - INTEGER(HID_T), INTENT(OUT) :: plist_id - INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T), INTENT(OUT) :: plist_id + INTEGER , INTENT(OUT) :: hdferr !***** INTERFACE INTEGER FUNCTION h5dget_access_plist_c(dset_id, plist_id) BIND(C,NAME='h5dget_access_plist_c') @@ -1174,15 +1183,15 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: plist_id END FUNCTION h5dget_access_plist_c END INTERFACE - + hdferr = h5dget_access_plist_c(dset_id, plist_id) - + END SUBROUTINE h5dget_access_plist_f SUBROUTINE h5dwrite_reference_obj(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1214,7 +1223,7 @@ CONTAINS SUBROUTINE h5dwrite_reference_dsetreg(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1276,7 +1285,7 @@ CONTAINS SUBROUTINE h5dwrite_char_scalar(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1286,7 +1295,7 @@ CONTAINS INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id ! Memory dataspace identfier INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id ! File dataspace identfier INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp ! Transfer property list identifier - + CALL h5dwrite_char_scalar_fix(dset_id, mem_type_id, buf, LEN(buf), dims, hdferr, & mem_space_id, file_space_id, xfer_prp) @@ -1294,7 +1303,7 @@ CONTAINS SUBROUTINE h5dwrite_char_scalar_fix(dset_id, mem_type_id, buf, buf_len, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1327,7 +1336,7 @@ CONTAINS SUBROUTINE h5dread_reference_obj(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1422,7 +1431,7 @@ CONTAINS SUBROUTINE h5dread_char_scalar(dset_id, mem_type_id, buf, dims, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1452,7 +1461,7 @@ CONTAINS SUBROUTINE h5dread_char_scalar_fix(dset_id, mem_type_id, buf, buf_len, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1474,17 +1483,17 @@ CONTAINS !****s* H5D (F03)/h5dwrite_f_F03 ! -! NAME +! NAME ! h5dwrite_f_F03 ! ! PURPOSE -! Writes raw data from a dataset into a buffer. +! Writes raw data from a dataset into a buffer. ! ! Inputs: ! dset_id - Identifier of the dataset to write to. ! mem_type_id - Identifier of the memory datatype. ! buf - Buffer with data to be written to the file. -! +! ! Outputs: ! hdferr - Returns 0 if successful and -1 if fails ! @@ -1510,7 +1519,7 @@ CONTAINS !***** SUBROUTINE h5dwrite_ptr(dset_id, mem_type_id, buf, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1539,16 +1548,16 @@ CONTAINS !****s* H5D (F03)/h5dread_f_F03 ! -! NAME +! NAME ! h5dread_f_F03 ! ! PURPOSE -! Reads raw data from a dataset into a buffer. +! Reads raw data from a dataset into a buffer. ! ! Inputs: ! dset_id - Identifier of the dataset read from. ! mem_type_id - Identifier of the memory datatype. -! +! ! Outputs: ! buf - Buffer to receive data read from file. ! hdferr - Returns 0 if successful and -1 if fails @@ -1575,7 +1584,7 @@ CONTAINS !***** SUBROUTINE h5dread_ptr(dset_id, mem_type_id, buf, hdferr, & mem_space_id, file_space_id, xfer_prp) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier @@ -1603,10 +1612,10 @@ CONTAINS END SUBROUTINE h5dread_ptr ! -! NAME +! NAME ! h5dfill_integer ! -! PURPOSE +! PURPOSE ! Fills dataspace elements with a fill value in a memory buffer. ! Only INTEGER, CHARACTER, REAL and DOUBLE PRECISION datatypes ! of the fillvalues and buffers are supported. Buffer and fillvalue @@ -1629,7 +1638,7 @@ CONTAINS ! SUBROUTINE h5dfill_integer(fill_value, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER, INTENT(IN), TARGET :: fill_value ! Fill value INTEGER(HID_T), INTENT(IN) :: space_id ! Memory dataspace selection identifier @@ -1679,7 +1688,7 @@ CONTAINS ! March 12, 2003 ! SUBROUTINE h5dfill_c_float(fill_valuer, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE REAL(KIND=C_FLOAT), INTENT(IN), TARGET :: fill_valuer ! Fill value INTEGER(HID_T), INTENT(IN) :: space_id ! Memory dataspace selection identifier @@ -1777,10 +1786,10 @@ CONTAINS END SUBROUTINE h5dfill_c_long_double #endif ! -! NAME +! NAME ! h5dfill_char ! -! PURPOSE +! PURPOSE ! Fills dataspace elements with a fill value in a memory buffer. ! Only INTEGER, CHARACTER, REAL and DOUBLE PRECISION datatypes ! of the fillvalues and buffers are supported. Buffer and fillvalue @@ -1801,7 +1810,7 @@ CONTAINS ! March 12, 2003 ! SUBROUTINE h5dfill_char(fill_value, space_id, buf, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE CHARACTER, INTENT(IN), TARGET :: fill_value ! Fill value INTEGER(HID_T), INTENT(IN) :: space_id ! Memory dataspace selection identifier @@ -1826,15 +1835,15 @@ CONTAINS ! NAME ! h5dvlen_reclaim_f ! -! PURPOSE -! Reclaims VL datatype memory buffers. +! PURPOSE +! Reclaims VL datatype memory buffers. ! ! Inputs: ! -! type_id - Identifier of the datatype. -! space_id - Identifier of the dataspace. -! plist_id - Identifier of the property list used to create the buffer. -! buf - Pointer to the buffer to be reclaimed. +! type_id - Identifier of the datatype. +! space_id - Identifier of the dataspace. +! plist_id - Identifier of the property list used to create the buffer. +! buf - Pointer to the buffer to be reclaimed. ! ! Outputs: ! hdferr - Returns 0 if successful and -1 if fails diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 0a2f2a3..6631d3a 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -164,7 +164,7 @@ h5eget_major_c(int_f* error_no, _fcd name, size_t_f* namelen) size_t c_namelen = (size_t)*namelen; int_f ret_value = 0; - if(c_namelen > 0) + if(c_namelen > 0) c_name = (char *)HDmalloc(c_namelen + 1); if(!c_name) @@ -212,7 +212,7 @@ h5eget_minor_c(int_f* error_no, _fcd name, size_t_f* namelen) size_t c_namelen = (size_t)*namelen; int_f ret_value = 0; - if(c_namelen > 0) + if(c_namelen > 0) c_name = (char *)HDmalloc(c_namelen + 1); if(!c_name) @@ -242,7 +242,7 @@ done: * estack_id - Error stack identifier. * func - Function to be called upon an error condition. * client_data - Data passed to the error function. - * + * * RETURNS * 0 on success, -1 on failure * AUTHOR diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index fcd08ff..1e94c7a 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -254,7 +254,7 @@ CONTAINS ! estack_id - Error stack identifier. ! func - Function to be called upon an error condition. ! client_data - Data passed to the error function -! +! ! Outputs: ! hdferr - Returns 0 if successful and -1 if fails ! @@ -264,7 +264,7 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR INTEGER , INTENT(IN) :: printflag INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index 2d5f6ed..7123f1d 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -402,52 +402,6 @@ h5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id) return ret_value; } -/****if* H5Ff/h5fis_hdf5_c - * NAME - * h5fis_hdf5_c - * PURPOSE - * Call H5Fis_hdf5 to determone if the file is an HDF5 file - * INPUTS - * name - name of the file - * namelen - name length - * OUTPUTS - * flag - 0 if file is not HDF5 file , positive if a file - * is an HDF5 file, and negative on failure. - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Tuesday, August 3, 1999 - * HISTORY - * - * SOURCE -*/ -int_f -h5fis_hdf5_c (_fcd name, int_f *namelen, int_f *flag) -/******/ -{ - int ret_value = -1; - char *c_name; - int_f c_namelen; - htri_t status; - - /* - * Convert FORTRAN name to C name - */ - c_namelen = *namelen; - c_name = (char *)HD5f2cstring(name, (size_t)c_namelen); - if (c_name == NULL) return ret_value; - - /* - * Call H5Fopen function. - */ - status = H5Fis_hdf5(c_name); - *flag = (int_f)status; - if (status >= 0) ret_value = 0; - - HDfree(c_name); - return ret_value; -} /****if* H5Ff/h5fclose_c * NAME * h5fclose_c @@ -532,11 +486,11 @@ h5fget_obj_count_c ( hid_t_f *file_id , int_f *obj_type, size_t_f * obj_count) * Changed type of max_obj to size_t_f; added parameter for the * number of open objects * Thursday, September 25, 2008 EIP - * + * * SOURCE */ int_f -h5fget_obj_ids_c ( hid_t_f *file_id , int_f *obj_type, size_t_f *max_objs, +h5fget_obj_ids_c ( hid_t_f *file_id , int_f *obj_type, size_t_f *max_objs, hid_t_f *obj_ids, size_t_f *num_objs) /******/ { @@ -678,6 +632,40 @@ done: return ret_value; } +/****if* H5Ff/h5fget_fileno_c + * NAME + * h5fget_fileno_c + * PURPOSE + * Call H5Fget_fileno to get file number + * INPUTS + * file_id - file identifier + * OUTPUTS + * fileno - file number for open file + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * Quincey Koziol + * Saturday, April 13, 2019 + * SOURCE +*/ +int_f +h5fget_fileno_c(hid_t_f *file_id, int_f *fileno) +/******/ +{ + unsigned long fileno_c; + herr_t ret_value=0; /* Return value */ + + /* + * Call H5Fget_filesize function + */ + if ((ret_value = H5Fget_fileno((hid_t)*file_id, &fileno_c)) < 0) + HGOTO_DONE(FAIL); + *fileno = (hsize_t_f)fileno_c; + +done: + return ret_value; +} + /****if* H5Ff/h5fget_file_image_c * NAME * h5fget_file_image_c @@ -705,7 +693,7 @@ h5fget_file_image_c(hid_t_f *file_id, void *buf_ptr, size_t_f *buf_len, size_t_f /* * Call h5fget_file_image function */ - + if ( (c_buf_req = H5Fget_file_image((hid_t)*file_id, buf_ptr, (size_t)*buf_len)) < 0) HGOTO_DONE(FAIL); diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index a3bef37..d74400c 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -42,6 +42,21 @@ MODULE H5F USE H5GLOBAL IMPLICIT NONE + ! Number of objects opened in H5open_f + INTEGER(SIZE_T) :: H5OPEN_NUM_OBJ + + INTERFACE + INTEGER(C_INT) FUNCTION h5fis_accessible(name, & + access_prp_default) BIND(C,NAME='H5Fis_accessible') + IMPORT :: C_CHAR + IMPORT :: HID_T + IMPORT :: C_INT + IMPLICIT NONE + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(IN), VALUE :: access_prp_default + END FUNCTION h5fis_accessible + END INTERFACE + CONTAINS !****s* H5F/h5fcreate_f ! @@ -483,6 +498,63 @@ CONTAINS END SUBROUTINE h5fget_access_plist_f +!****s* H5F/h5fis_accessible_f +! +! NAME +! h5fis_accessible_f +! +! PURPOSE +! Determines whether a file can be accessed as HDF5. +! +! INPUTS +! name - name of the file to check +! OUTPUTS +! status - indicates if file is and HDF5 file +! hdferr - Returns 0 if successful and -1 if fails +! OPTIONAL PARAMETERS +! access_prp - file access property list identifier +! AUTHOR +! Dana Robinson +! September 2018 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! SOURCE + SUBROUTINE h5fis_accessible_f(name, status, hdferr, access_prp) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the file + LOGICAL, INTENT(OUT) :: status ! Indicates if file + ! is an HDF5 file + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + ! File access property list + ! identifier +!***** + INTEGER(HID_T) :: access_prp_default + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + INTEGER(C_INT) :: flag ! "TRUE/FALSE/ERROR" flag from C routine + + access_prp_default = H5P_DEFAULT_F + IF (PRESENT(access_prp)) access_prp_default = access_prp + + c_name = TRIM(name)//C_NULL_CHAR + + flag = H5Fis_accessible(c_name, access_prp_default) + + hdferr = 0 + IF(flag.LT.0) hdferr = -1 + + status = .TRUE. + IF (flag .EQ. 0) status = .FALSE. + + END SUBROUTINE h5fis_accessible_f + +! XXX (VOL_MERGE): This function should probably be marked as +! deprecated since H5Fis_hdf5() is deprecated. + !****s* H5F/h5fis_hdf5_f ! ! NAME @@ -500,6 +572,12 @@ CONTAINS ! Elena Pourmal ! August 12, 1999 ! +! NOTES +! The underlying HDF5 C API call (H5Fis_hdf5) has been deprecated +! in favor of the VOL-capable H5Fis_accessible(). New code should +! use h5fis_accessible_f() instead of this function in case this +! function is deprecated in the future. +! ! HISTORY ! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows @@ -513,26 +591,22 @@ CONTAINS ! is an HDF5 file INTEGER, INTENT(OUT) :: hdferr ! Error code !***** - INTEGER :: namelen ! Length of the name character string - INTEGER :: flag ! "TRUE/FALSE" flag from C routine - ! to define status value. + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + INTEGER(C_INT) :: flag ! "TRUE/FALSE/ERROR" flag from C routine + ! to define status value. - INTERFACE - INTEGER FUNCTION h5fis_hdf5_c(name, namelen, flag) BIND(C,NAME='h5fis_hdf5_c') - IMPORT :: C_CHAR - IMPLICIT NONE - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER :: flag - END FUNCTION h5fis_hdf5_c - END INTERFACE + c_name = TRIM(name)//C_NULL_CHAR + + flag = H5Fis_accessible(c_name, H5P_DEFAULT_F) + + hdferr = 0 + IF(flag.LT.0) hdferr = -1 - namelen = LEN_TRIM(name) - hdferr = h5fis_hdf5_c(name, namelen, flag) status = .TRUE. IF (flag .EQ. 0) status = .FALSE. END SUBROUTINE h5fis_hdf5_f + !****s* H5F/h5fclose_f ! ! NAME @@ -619,6 +693,11 @@ CONTAINS hdferr = h5fget_obj_count_c(file_id, obj_type, obj_count) + ! Don't include objects created by H5open in the H5F_OBJ_ALL_F count + IF(file_id.EQ.INT(H5F_OBJ_ALL_F,HID_T))THEN + obj_count = obj_count - H5OPEN_NUM_OBJ + ENDIF + END SUBROUTINE h5fget_obj_count_f !****s* H5F/h5fget_obj_ids_f @@ -806,13 +885,51 @@ CONTAINS hdferr = h5fget_filesize_c(file_id, size) END SUBROUTINE h5fget_filesize_f +!****s* H5F/h5fget_fileno_f +! +! NAME +! h5fget_fileno_f +! +! PURPOSE +! Retrieves the file number of the HDF5 file. +! +! INPUTS +! file_id - file identifier +! OUTPUTS +! fileno - file number +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! Quincey Koziol +! April 13, 2019 +! +! SOURCE + SUBROUTINE h5fget_fileno_f(file_id, fileno, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id ! file identifier + INTEGER, INTENT(OUT) :: fileno ! File number + INTEGER, INTENT(OUT) :: hdferr ! Error code: 0 on success, + ! -1 if fail +!***** + INTERFACE + INTEGER FUNCTION h5fget_fileno_c(file_id, fileno) & + BIND(C,NAME='h5fget_fileno_c') + IMPORT :: HID_T, HSIZE_T + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id + INTEGER, INTENT(OUT) :: fileno + END FUNCTION h5fget_fileno_c + END INTERFACE + hdferr = h5fget_fileno_c(file_id, fileno) + END SUBROUTINE h5fget_fileno_f + !****s* H5F (F03)/h5fget_file_image_f_F03 ! ! NAME ! h5fget_file_image_f ! ! PURPOSE -! Retrieves a copy of the image of an existing, open file. +! Retrieves a copy of the image of an existing, open file. ! ! INPUTS ! file_id - Target file identifier. @@ -822,7 +939,7 @@ CONTAINS ! OUTPUTS ! hdferr - error code: ! 0 on success and -1 on failure -! OPTIONAL PARAMETERS +! OPTIONAL PARAMETERS ! buf_size - Returns the size in bytes of the buffer required to store the file image, ! no data will be copied. ! @@ -850,7 +967,7 @@ CONTAINS INTEGER(HID_T) , INTENT(IN) :: file_id TYPE(C_PTR) , VALUE :: buf_ptr INTEGER(SIZE_T), INTENT(IN) :: buf_len - INTEGER(SIZE_T), INTENT(IN) :: buf_size + INTEGER(SIZE_T), INTENT(OUT) :: buf_size END FUNCTION h5fget_file_image_c END INTERFACE @@ -866,4 +983,97 @@ CONTAINS END SUBROUTINE h5fget_file_image_f +!****s* H5F (F03)/h5fget_dset_no_attrs_hint_f_F03 +! +! NAME +! h5fget_dset_no_attrs_hint_f +! +! PURPOSE +! Gets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! file_id - Target file identifier. +! +! OUTPUTS +! minimize - Value of the setting. +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5fget_dset_no_attrs_hint_f(file_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: file_id + LOGICAL , INTENT(OUT) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5fget_dset_no_attrs_hint_c(file_id, minimize) BIND(C, NAME='H5Fget_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: file_id + LOGICAL(C_BOOL), INTENT(OUT) :: minimize + END FUNCTION h5fget_dset_no_attrs_hint_c + END INTERFACE + + hdferr = INT(h5fget_dset_no_attrs_hint_c(file_id, c_minimize)) + + ! Transfer value of C C_BOOL type to Fortran LOGICAL + minimize = c_minimize + + END SUBROUTINE h5fget_dset_no_attrs_hint_f + +!****s* H5F (F03)/h5fset_dset_no_attrs_hint_f_F03 +! +! NAME +! h5fset_dset_no_attrs_hint_f +! +! PURPOSE +! Sets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! file_id - Target file identifier. +! minimize - Value of the setting. +! +! OUTPUTS +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5fset_dset_no_attrs_hint_f(file_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: file_id + LOGICAL , INTENT(IN) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5fset_dset_no_attrs_hint_c(file_id, minimize) BIND(C, NAME='H5Fset_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: file_id + LOGICAL(C_BOOL), INTENT(IN), VALUE :: minimize + END FUNCTION h5fset_dset_no_attrs_hint_c + END INTERFACE + + ! Transfer value of Fortran LOGICAL to C C_BOOL type + c_minimize = minimize + + hdferr = INT(h5fset_dset_no_attrs_hint_c(file_id, c_minimize)) + + END SUBROUTINE h5fset_dset_no_attrs_hint_f + END MODULE H5F + diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index 720bd49..770752d 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -47,7 +47,7 @@ */ int_f h5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, - hid_t_f *grp_id, hid_t_f *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id ) + hid_t_f *grp_id, hid_t_f *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id ) /******/ { hid_t c_gcpl_id = -1; /* Group creation property list */ @@ -69,11 +69,11 @@ h5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, else { /* Create the group creation property list */ if((c_gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 0) - goto DONE; + goto DONE; /* Set the local heap size hint */ if(H5Pset_local_heap_size_hint(c_gcpl_id, (size_t)*size_hint) < 0) - goto DONE; + goto DONE; /* Create the group */ c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, c_gcpl_id, H5P_DEFAULT); @@ -170,7 +170,7 @@ h5gget_obj_info_idx_c(hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *idx, _fcd obj_name, int_f *obj_namelen, int_f *obj_type) /******/ { - H5O_info_t oinfo; + H5O_info2_t oinfo; hid_t c_loc_id = (hid_t)*loc_id; char *c_name = NULL; size_t c_obj_namelen; @@ -200,7 +200,7 @@ h5gget_obj_info_idx_c(hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *idx, /* Query the object's information */ if(H5Lget_name_by_idx(gid, ".", H5_INDEX_NAME, H5_ITER_INC, c_idx, c_obj_name, c_obj_namelen, H5P_DEFAULT) < 0) goto DONE; - if(H5Oget_info_by_idx(gid, ".", H5_INDEX_NAME, H5_ITER_INC, c_idx, &oinfo, H5P_DEFAULT) < 0) + if(H5Oget_info_by_idx3(gid, ".", H5_INDEX_NAME, H5_ITER_INC, c_idx, &oinfo, H5O_INFO_BASIC, H5P_DEFAULT) < 0) goto DONE; /* XXX: Switch from using H5Gget_objtype_by_idx() means that this routine won't @@ -308,9 +308,9 @@ h5gclose_c(hid_t_f *grp_id) * link_type - link type * current_name - name of the existing object for hard link, * anything for the soft link - * current_namelen - current name lenghth + * current_namelen - current name length * new_name - new name for the object - * new_namelen - new_name lenghth + * new_namelen - new_name length * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -365,7 +365,7 @@ h5glink_c(hid_t_f *loc_id, int_f *link_type, _fcd current_name, goto DONE; break; /* End of the warnings fix */ - + default: /* Unknown/unhandled link type */ goto DONE; } /* end switch */ @@ -390,12 +390,12 @@ DONE: * cur_name - name of the existing object for hard link releative * to cur_loc_id location, * anything for the soft link - * current_namelen - current name lenghth + * current_namelen - current name length * link_type - link type * new_loc_id - location identifier * new_name - new name for the object releative to the new_loc_id * location - * new_namelen - new_name lenghth + * new_namelen - new_name length * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -515,9 +515,9 @@ DONE: * INPUTS * loc_id - identifier of file or group * src_name - name of the original object - * src_namelen - original name lenghth + * src_namelen - original name length * dst_name - new name for the object - * dst_namelen - new name lenghth + * dst_namelen - new name length * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -565,10 +565,10 @@ DONE: * INPUTS * src_loc_id - identifier of file or group * src_name - name of the original object relative to src_loc_id - * src_namelen - original name lenghth + * src_namelen - original name length * dst_loc_id - new location identifier * dst_name - new name for the object relative to dst_loc_id - * dst_namelen - new name lenghth + * dst_namelen - new name length * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -617,8 +617,8 @@ DONE: * INPUTS * loc_id - identifier of file or group * name - name of the object that symbolic link points to - * namelen - the name lenghth - * size - lenghth of retrurned value + * namelen - the name length + * size - length of retrurned value * OUTPUTS * value - name to be returned * RETURNS @@ -681,9 +681,9 @@ DONE: * INPUTS * loc_id - identifier of file or group * name - name of object whose comment is to be set or reset - * namelen - the name lenghth + * namelen - the name length * comment - the new comment - * commentlen - new comment lenghth + * commentlen - new comment length * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -732,7 +732,7 @@ DONE: * INPUTS * loc_id - identifier of file or group * name - name of object whose comment is to be set or reset - * namelen - the name lenghth + * namelen - the name length * bufsize - at most bufsize characters * comment - the new comment * RETURNS @@ -948,8 +948,8 @@ done: */ int_f h5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, - int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, - int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted ) + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, + int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted ) /******/ { char *c_group_name = NULL; /* Buffer to hold group name C string */ @@ -965,7 +965,7 @@ h5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, * Call H5Gget_info_by_idx function. */ if(H5Gget_info_by_idx((hid_t)*loc_id,c_group_name, (H5_index_t)*index_type,(H5_iter_order_t)*order,(hsize_t)*n, - &ginfo, (hid_t)*lapl_id) < 0) + &ginfo, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); /* Unpack the structure */ @@ -1018,7 +1018,7 @@ h5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, */ int_f h5gget_info_by_name_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, hid_t_f *lapl_id, - int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted) + int_f *storage_type, int_f *nlinks, int_f *max_corder, int_f *mounted) /******/ { char *c_group_name = NULL; /* Buffer to hold group name C string */ diff --git a/fortran/src/H5Gff.F90 b/fortran/src/H5Gff.F90 index 0684508..942cc51 100644 --- a/fortran/src/H5Gff.F90 +++ b/fortran/src/H5Gff.F90 @@ -64,11 +64,11 @@ CONTAINS ! gcpl_id - Property list for group creation ! gapl_id - Property list for group access ! -! AUTHOR +! AUTHOR ! Elena Pourmal ! August 12, 1999 ! -! HISTORY +! HISTORY ! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 5, 2001 @@ -668,7 +668,7 @@ CONTAINS !***** INTEGER :: namelen ! Lenghth of the current_name string INTEGER :: new_namelen ! Lenghth of the new_name string - + INTERFACE INTEGER FUNCTION h5gmove_c(loc_id, name, namelen, new_name, new_namelen) BIND(C,NAME='h5gmove_c') IMPORT :: C_CHAR @@ -680,7 +680,7 @@ CONTAINS INTEGER :: new_namelen END FUNCTION h5gmove_c END INTERFACE - + namelen = LEN(name) new_namelen = LEN(new_name) hdferr = h5gmove_c(loc_id, name, namelen, new_name, new_namelen) @@ -716,7 +716,7 @@ CONTAINS !***** INTEGER :: src_namelen ! Length of the current_name string INTEGER :: dst_namelen ! Lenghth of the new_name string - + INTERFACE INTEGER FUNCTION h5gmove2_c(src_loc_id, src_name, src_namelen, & dst_loc_id, dst_name, dst_namelen) BIND(C,NAME='h5gmove2_c') @@ -730,7 +730,7 @@ CONTAINS INTEGER :: dst_namelen END FUNCTION h5gmove2_c END INTERFACE - + src_namelen = LEN(src_name) dst_namelen = LEN(dst_name) hdferr = h5gmove2_c(src_loc_id, src_name, src_namelen, dst_loc_id, dst_name, dst_namelen) @@ -777,7 +777,7 @@ CONTAINS INTEGER, INTENT(OUT) :: hdferr ! Error code !***** INTEGER :: namelen ! Lenghth of the current_name string - + INTERFACE INTEGER FUNCTION h5gget_linkval_c(loc_id, name, namelen, size, buffer) BIND(C,NAME='h5gget_linkval_c') IMPORT :: C_CHAR, SIZE_T @@ -789,7 +789,7 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: buffer END FUNCTION h5gget_linkval_c END INTERFACE - + namelen = LEN(name) hdferr = h5gget_linkval_c(loc_id, name, namelen, size, buffer) END SUBROUTINE h5gget_linkval_f @@ -829,7 +829,7 @@ CONTAINS !***** INTEGER :: namelen ! Lenghth of the current_name string INTEGER :: commentlen ! Lenghth of the comment string - + INTERFACE INTEGER FUNCTION h5gset_comment_c(loc_id, name, namelen, & comment, commentlen) BIND(C,NAME='h5gset_comment_c') @@ -842,7 +842,7 @@ CONTAINS INTEGER :: commentlen END FUNCTION h5gset_comment_c END INTERFACE - + namelen = LEN(name) commentlen = LEN(comment) hdferr = h5gset_comment_c(loc_id, name, namelen, comment, commentlen) @@ -1004,7 +1004,7 @@ CONTAINS ! INPUTS ! group_id - Group identifier ! -! OUTPUTS +! OUTPUTS ! storage_type - Type of storage for links in group ! H5G_STORAGE_TYPE_COMPACT: Compact storage ! H5G_STORAGE_TYPE_DENSE: Indexed storage diff --git a/fortran/src/H5Iff.F90 b/fortran/src/H5Iff.F90 index 351dd4b..d9c3d49 100644 --- a/fortran/src/H5Iff.F90 +++ b/fortran/src/H5Iff.F90 @@ -38,7 +38,7 @@ !***** MODULE H5I - + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL @@ -305,10 +305,10 @@ CONTAINS ! Check if an ID is valid without producing an error message ! ! INPUTS -! id - identifier -! OUTPUTS +! id - identifier +! OUTPUTS ! valid - status of id as a valid identifier -! hdferr: - error code +! hdferr: - error code ! Success: 0 ! Failure: -1 ! @@ -318,26 +318,26 @@ CONTAINS ! SOURCE SUBROUTINE h5iis_valid_f(id, valid, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: id ! Identifier + INTEGER(HID_T), INTENT(IN) :: id ! Identifier LOGICAL, INTENT(OUT) :: valid ! Status of id as a valid identifier INTEGER, INTENT(OUT) :: hdferr ! Error code !***** INTEGER :: c_valid ! 0 = .false, 1 = .true. - + INTERFACE INTEGER FUNCTION h5iis_valid_c(id, c_valid) BIND(C, NAME='h5iis_valid_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: id ! Identifier + INTEGER(HID_T), INTENT(IN) :: id ! Identifier INTEGER :: c_valid END FUNCTION h5iis_valid_c END INTERFACE - + hdferr = h5iis_valid_c(id, c_valid) - + valid = .FALSE. ! Default IF(c_valid.EQ.1) valid = .TRUE. - + END SUBROUTINE h5iis_valid_f END MODULE H5I diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c index 32de037..1fee5e8 100644 --- a/fortran/src/H5Lf.c +++ b/fortran/src/H5Lf.c @@ -441,7 +441,7 @@ done: * H5L_LINK_SOFT_F - Soft link * H5L_LINK_EXTERNAL_F - External link * H5L_LINK_ERROR_F - Error - * address - If the link is a hard link, address specifies the file address that the link points to + * token - If the link is a hard link, token specifies the token for the object that the link points to * val_size - If the link is a symbolic link, val_size will be the length of the link value * * RETURNS @@ -456,13 +456,12 @@ done: int_f h5lget_info_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, - haddr_t_f *address, size_t_f *val_size, - hid_t_f *lapl_id) + H5O_token_t *token, size_t_f *val_size, hid_t_f *lapl_id) /******/ { char *c_link_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ - H5L_info_t link_buff; + H5L_info2_t link_buff; /* * Convert FORTRAN name to C name @@ -473,7 +472,7 @@ h5lget_info_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, /* * Call H5Linfo function. */ - if(H5Lget_info((hid_t)*link_loc_id, c_link_name, &link_buff, (hid_t)*lapl_id) < 0) + if(H5Lget_info2((hid_t)*link_loc_id, c_link_name, &link_buff, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); /* Unpack the structure */ @@ -482,7 +481,7 @@ h5lget_info_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, *corder_valid = 0; if(link_buff.corder_valid > 0) *corder_valid = 1; *link_type = (int_f)link_buff.type; - *address = (haddr_t_f)link_buff.u.address; + *token = link_buff.u.token; *val_size = (size_t_f)link_buff.u.val_size; done: @@ -525,14 +524,15 @@ done: int_f h5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_field, int_f *order, hsize_t_f *n, - int_f *link_type, int_f *corder_valid, int_f *corder, int_f *cset, haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id) + int_f *link_type, int_f *corder_valid, int_f *corder, + int_f *cset, H5O_token_t *token, size_t_f *val_size, hid_t_f *lapl_id) /******/ { char *c_group_name = NULL; /* Buffer to hold C string */ H5_index_t c_index_field; H5_iter_order_t c_order; int_f ret_value = 0; /* Return value */ - H5L_info_t link_buff; + H5L_info2_t link_buff; /* * Convert FORTRAN name to C name @@ -545,7 +545,7 @@ h5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, /* * Call H5Linfo_by_idx function. */ - if(H5Lget_info_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, + if(H5Lget_info_by_idx2((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, &link_buff, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); @@ -557,7 +557,7 @@ h5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, *corder = (int_f)link_buff.corder; *cset = (int_f)link_buff.cset; *link_type = (int_f)link_buff.type; - *address = (haddr_t_f)link_buff.u.address; + *token = link_buff.u.token; *val_size = (size_t_f)link_buff.u.val_size; done: @@ -939,7 +939,7 @@ int_f h5lget_val_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, size_t_f *size, void *linkval_buff, hid_t_f *lapl_id) /******/ -{ +{ char *c_link_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ @@ -988,7 +988,7 @@ done: * SOURCE */ int_f -h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate_t op, void *op_data ) +h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate2_t op, void *op_data ) /******/ { int_f ret_value = -1; /* Return value */ @@ -1001,7 +1001,7 @@ h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, * Call H5Linterate */ - func_ret_value = H5Literate( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, &idx_c, op, op_data); + func_ret_value = H5Literate2( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, &idx_c, op, op_data); ret_value = (int_f)func_ret_value; *idx = (hsize_t_f)idx_c; @@ -1038,7 +1038,7 @@ h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, * SOURCE */ int_f -h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate_t op, void *op_data, hid_t_f *lapl_id) +h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate2_t op, void *op_data, hid_t_f *lapl_id) /******/ { int_f ret_value = -1; /* Return value */ @@ -1058,7 +1058,7 @@ h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index * Call H5Linterate */ - func_ret_value = H5Literate_by_name((hid_t)*loc_id, c_name,(H5_index_t)*index_type,(H5_iter_order_t)*order,&idx_c,op,op_data,(hid_t)*lapl_id); + func_ret_value = H5Literate_by_name2((hid_t)*loc_id, c_name,(H5_index_t)*index_type,(H5_iter_order_t)*order,&idx_c,op,op_data,(hid_t)*lapl_id); ret_value = (int_f)func_ret_value; *idx = (hsize_t_f)idx_c; @@ -1068,6 +1068,3 @@ h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index return ret_value; } - - - diff --git a/fortran/src/H5Lff.F90 b/fortran/src/H5Lff.F90 index d5bb1d1..2901a16 100644 --- a/fortran/src/H5Lff.F90 +++ b/fortran/src/H5Lff.F90 @@ -46,7 +46,7 @@ MODULE H5L ! Fortran2003 Derived Type: ! TYPE, bind(c) :: union_t - INTEGER(haddr_t) :: address + TYPE(H5O_TOKEN_T_F) :: token INTEGER(size_t) :: val_size END TYPE union_t @@ -64,10 +64,10 @@ MODULE H5L ! H5L_TYPE_HARD Hard link ! H5L_TYPE_SOFT Soft link ! H5L_TYPE_EXTERNAL External link -! H5L_TYPE_ERROR Error +! H5L_TYPE_ERROR Error !cset specifies the character set in which the link name is encoded. Valid values include the following: ! H5T_CSET_ASCII US ASCII -! H5T_CSET_UTF8 UTF-8 Unicode encoding +! H5T_CSET_UTF8 UTF-8 Unicode encoding CONTAINS @@ -593,7 +593,7 @@ CONTAINS ! link_loc_id - File or group identifier. ! link_name - Name of the link for which information is being sought ! -! OUTPUTS +! OUTPUTS ! NOTE: In C these are contained in the structure H5L_info_t ! ! cset - indicates the character set used for link’s name. @@ -604,9 +604,9 @@ CONTAINS ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR_ F - Error -! address - If the link is a hard link, address specifies the file address that the link points to -! val_size - If the link is a symbolic link, val_size will be the length of the link value, e.g., -! the length of the name of the pointed-to object with a null terminator. +! token - If the link is a hard link, token specifies the object token that the link points to +! val_size - If the link is a symbolic link, val_size will be the length of the link value, e.g., +! the length of the name of the pointed-to object with a null terminator. ! hdferr - Returns 0 if successful and -1 if fails ! ! OPTIONAL PARAMETERS @@ -625,7 +625,7 @@ CONTAINS ! ! SOURCE SUBROUTINE h5lget_info_f(link_loc_id, link_name, & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & hdferr, lapl_id) IMPLICIT NONE @@ -641,9 +641,9 @@ CONTAINS ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR _F - Error - INTEGER(HADDR_T), INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to - INTEGER(SIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value, e.g., - ! the length of the name of the pointed-to object with a null terminator. + TYPE(H5O_TOKEN_T_F), INTENT(OUT), TARGET :: token ! If the link is a hard link, token specifies the object token that the link points to + INTEGER(SIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value, e.g., + ! the length of the name of the pointed-to object with a null terminator. INTEGER, INTENT(OUT) :: hdferr ! Error code: ! 0 on success and -1 on failure INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list @@ -654,17 +654,17 @@ CONTAINS INTERFACE INTEGER FUNCTION h5lget_info_c(link_loc_id, link_name, link_namelen, & - cset, corder, corder_valid, link_type, address, val_size, & + cset, corder, corder_valid, link_type, token, val_size, & lapl_id_default) BIND(C,NAME='h5lget_info_c') IMPORT :: c_char - IMPORT :: HID_T, SIZE_T, HADDR_T + IMPORT :: HID_T, SIZE_T, H5O_TOKEN_T_F IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: link_loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: link_name INTEGER, INTENT(OUT) :: cset INTEGER, INTENT(OUT) :: corder INTEGER, INTENT(OUT) :: link_type - INTEGER(HADDR_T), INTENT(OUT) :: address + TYPE(H5O_TOKEN_T_F), INTENT(OUT) :: token INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER(HID_T) :: lapl_id_default INTEGER(SIZE_T) :: link_namelen @@ -677,10 +677,8 @@ CONTAINS lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - hdferr = h5lget_info_c(link_loc_id, link_name, link_namelen, & - cset, corder, corder_valid, link_type, & - address, val_size, & - lapl_id_default) + hdferr = h5lget_info_c(link_loc_id, link_name, link_namelen, cset, & + corder, corder_valid, link_type, token, val_size, lapl_id_default) f_corder_valid =.FALSE. IF(corder_valid .EQ. 1) f_corder_valid =.TRUE. @@ -703,13 +701,13 @@ CONTAINS ! order - Order within field or index ! n - Link for which to retrieve information ! -! OUTPUTS +! OUTPUTS ! NOTE: In C these are defined as a structure: H5L_info_t ! corder_valid - Indicates whether the creation order data is valid for this attribute ! corder - Is a positive integer containing the creation order of the attribute -! cset - Indicates the character set used for the attribute’s name -! address - If the link is a hard link, address specifies the file address that the link points to -! val_size - If the link is a symbolic link, val_size will be the length of the link value, e.g., +! cset - Indicates the character set used for the attribute’s name +! token - If the link is a hard link, token specifies the object token that the link points to +! val_size - If the link is a symbolic link, val_size will be the length of the link value, e.g., ! the length of the name of the pointed-to object with a null terminator. ! hdferr - Returns 0 if successful and -1 if fails ! @@ -725,13 +723,13 @@ CONTAINS ! H5L_LINK_HARD_F, H5L_LINK_SOFT_F,H5L_LINK_EXTERNAL_F,H5L_LINK_ERROR_F ! to ! H5L_TYPE_HARD_F, H5L_TYPE_SOFT_F,H5L_TYPE_EXTERNAL_F,H5L_TYPE_ERROR_F -! MSB January 8, 2010. +! MSB January 8, 2010. ! ! SOURCE SUBROUTINE h5lget_info_by_idx_f(loc_id, group_name, index_field, order, n, & - link_type, f_corder_valid, corder, cset, address, val_size, hdferr, lapl_id) + link_type, f_corder_valid, corder, cset, token, val_size, hdferr, lapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of subject group INTEGER, INTENT(IN) :: index_field ! Index or field which determines the order ! H5_INDEX_UNKNOWN_F - Unknown index type @@ -749,12 +747,12 @@ CONTAINS ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR _F - Error - LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name - INTEGER(HADDR_T), INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to - INTEGER(SIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value, e.g., - ! the length of the name of the pointed-to object with a null terminator. + TYPE(H5O_TOKEN_T_F), INTENT(OUT), TARGET :: token ! If the link is a hard link, token specifies the object token that the link points to + INTEGER(SIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value, e.g., + ! the length of the name of the pointed-to object with a null terminator. INTEGER, INTENT(OUT) :: hdferr ! Error code: ! 0 on success and -1 on failure INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list @@ -767,10 +765,10 @@ CONTAINS ! INTERFACE INTEGER FUNCTION h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & - link_type, corder_valid, corder, cset, address, val_size, lapl_id_default) & + link_type, corder_valid, corder, cset, token, val_size, lapl_id_default) & BIND(C,NAME='h5lget_info_by_idx_c') IMPORT :: c_char - IMPORT :: HID_T, SIZE_T, HSIZE_T, HADDR_T + IMPORT :: HID_T, SIZE_T, HSIZE_T, H5O_TOKEN_T_F IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: group_name @@ -779,10 +777,10 @@ CONTAINS INTEGER, INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(IN) :: n INTEGER, INTENT(OUT) :: link_type - INTEGER :: corder_valid + INTEGER :: corder_valid INTEGER, INTENT(OUT) :: corder INTEGER, INTENT(OUT) :: cset - INTEGER(HADDR_T), INTENT(OUT) :: address + TYPE(H5O_TOKEN_T_F), INTENT(OUT) :: token INTEGER(SIZE_T), INTENT(OUT) :: val_size INTEGER(HID_T) :: lapl_id_default END FUNCTION h5lget_info_by_idx_c @@ -794,7 +792,7 @@ CONTAINS IF(PRESENT(lapl_id)) lapl_id_default = lapl_id hdferr = h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & - link_type, corder_valid, corder, cset, address, val_size, lapl_id_default) + link_type, corder_valid, corder, cset, token, val_size, lapl_id_default) f_corder_valid =.FALSE. IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. @@ -1345,7 +1343,7 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5literate_f(group_id, index_type, order, idx, op, op_data, return_value, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: group_id INTEGER , INTENT(IN) :: index_type @@ -1425,14 +1423,14 @@ CONTAINS ! Fortran2003 Interface: SUBROUTINE h5literate_by_name_f(loc_id, group_name, index_type, order, & idx, op, op_data, return_value, hdferr, lapl_id) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: group_name + CHARACTER(LEN=*), INTENT(IN) :: group_name INTEGER , INTENT(IN) :: index_type INTEGER , INTENT(IN) :: order INTEGER(HSIZE_T), INTENT(INOUT) :: idx - TYPE(C_FUNPTR) , INTENT(IN) :: op + TYPE(C_FUNPTR) , INTENT(IN) :: op TYPE(C_PTR) , INTENT(IN) :: op_data INTEGER , INTENT(OUT) :: return_value INTEGER , INTENT(OUT) :: hdferr diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 7d065a5..edbfcbe 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -22,16 +22,20 @@ #include "H5f90.h" #include "H5Eprivate.h" int_f -fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info); +fill_h5o_info_t_f(H5O_info2_t Oinfo, H5O_info_t_f *object_info); int_f -fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { +fill_h5o_info_t_f(H5O_info2_t Oinfo, H5O_info_t_f *object_info) { + + /* This function does not used the field parameter because we want + * this function to fill the unfilled fields with C's default values. + */ struct tm *ts; object_info->fileno = Oinfo.fileno; - object_info->addr = (haddr_t_f)Oinfo.addr; - + object_info->token = Oinfo.token; + object_info->type = (int_f)Oinfo.type; object_info->rc = (int_f)Oinfo.rc; @@ -81,22 +85,6 @@ fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { object_info->num_attrs = (hsize_t_f)Oinfo.num_attrs; - object_info->hdr.version = (int_f)Oinfo.hdr.version; - object_info->hdr.nmesgs = (int_f)Oinfo.hdr.nmesgs; - object_info->hdr.nchunks = (int_f)Oinfo.hdr.nchunks; - object_info->hdr.flags = (int_f)Oinfo.hdr.flags; - - object_info->hdr.space.total = (hsize_t_f)Oinfo.hdr.space.total; - object_info->hdr.space.meta = (hsize_t_f)Oinfo.hdr.space.meta; - object_info->hdr.space.mesg = (hsize_t_f)Oinfo.hdr.space.mesg; - object_info->hdr.space.free = (hsize_t_f)Oinfo.hdr.space.free; - - object_info->hdr.mesg.present = Oinfo.hdr.mesg.present; - object_info->hdr.mesg.shared = Oinfo.hdr.mesg.shared; - - object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size; - object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size; - return 0; } @@ -138,7 +126,7 @@ h5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen * Call H5Olink function. */ if((hid_t_f)H5Olink((hid_t)*object_id, (hid_t)*new_loc_id, c_name, - (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); done: @@ -196,7 +184,7 @@ h5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_ * PURPOSE * Call H5Oclose * INPUTS - * object_id - Object identifier + * object_id - Object identifier * RETURNS * 0 on success, -1 on failure * AUTHOR @@ -209,10 +197,10 @@ h5oclose_c ( hid_t_f *object_id ) /******/ { int_f ret_value=0; /* Return value */ - + if (H5Oclose((hid_t)*object_id) < 0) HGOTO_DONE(FAIL); - + done: return ret_value; } @@ -229,6 +217,7 @@ h5oclose_c ( hid_t_f *object_id ) * idx - Iteration position at which to start * op - Callback function passing data regarding the link to the calling application * op_data - User-defined pointer to data required by the application for its processing of the link + * fields - Flags specifying the fields to include in object_info. * * OUTPUTS * idx - Position at which an interrupted iteration may be restarted @@ -241,7 +230,8 @@ h5oclose_c ( hid_t_f *object_id ) * SOURCE */ int_f -h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data ) +h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate2_t op, + void *op_data, int_f *fields ) /******/ { int_f ret_value = -1; /* Return value */ @@ -250,24 +240,25 @@ h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, /* * Call H5Ovisit */ - func_ret_value = H5Ovisit( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, op_data); + + func_ret_value = H5Ovisit3( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, op_data, (unsigned)*fields); ret_value = (int_f)func_ret_value; return ret_value; } -/****if* H5Of/h5oopen_by_addr_c +/****if* H5Of/h5oopen_by_token_c * NAME - * h5oopen_by_addr_c + * h5oopen_by_token_c * PURPOSE - * Calls H5open_by_addr + * Calls H5open_by_token * INPUTS - * loc_id - File or group identifier - * addr - Object’s address in the file + * loc_id - File or group identifier + * token - Object’s token in the file * * OUTPUTS - * obj_id - Dataset identifier + * obj_id - Object identifier * * RETURNS * 0 on success, -1 on failure @@ -277,15 +268,15 @@ h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, * SOURCE */ int_f -h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) +h5oopen_by_token_c(hid_t_f *loc_id, H5O_token_t *token, hid_t_f *obj_id) /******/ { int_f ret_value = 0; /* Return value */ /* - * Call H5Oopen_by_address function. + * Call H5Oopen_by_token function. */ - if((*obj_id = (hid_t_f)H5Oopen_by_addr((hid_t)*loc_id, (haddr_t)*addr)) < 0) + if((*obj_id = (hid_t_f)H5Oopen_by_token((hid_t)*loc_id, *token)) < 0) HGOTO_DONE(FAIL); done: @@ -302,6 +293,7 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) * name - Name of group, relative to loc_id. * namelen - Name length. * lapl_id - Link access property list. + * fields - Flags specifying the fields to include in object_info. * OUTPUTS * object_info - Buffer in which to return object information. * @@ -314,13 +306,13 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) */ int_f h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info) + H5O_info_t_f *object_info, int_f *fields) /******/ { char *c_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ - H5O_info_t Oinfo; - + H5O_info2_t Oinfo; + /* * Convert FORTRAN name to C name */ @@ -330,11 +322,11 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l /* * Call H5Oinfo_by_name function. */ - if(H5Oget_info_by_name((hid_t)*loc_id, c_name, - &Oinfo, (hid_t)*lapl_id) < 0) + if(H5Oget_info_by_name3((hid_t)*loc_id, c_name, + &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); - ret_value = fill_h5o_info_t_f(Oinfo,object_info); + ret_value = fill_h5o_info_t_f(Oinfo, object_info); done: if(c_name) @@ -354,6 +346,7 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l * lapl_id - Link access property list. * OUTPUTS * object_info - Buffer in which to return object information. + * fields - Flags specifying the fields to include in object_info. * * RETURNS * 0 on success, -1 on failure @@ -363,16 +356,16 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l * SOURCE */ int_f -h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, - int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info) +h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields) /******/ { char *c_group_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ - H5O_info_t Oinfo; + H5O_info2_t Oinfo; H5_index_t c_index_field; H5_iter_order_t c_order; - + /* * Convert FORTRAN name to C name */ @@ -385,8 +378,8 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, /* * Call H5Oinfo_by_idx function. */ - if(H5Oget_info_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, - &Oinfo, (hid_t)*lapl_id) < 0) + if(H5Oget_info_by_idx3((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, + &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); ret_value = fill_h5o_info_t_f(Oinfo,object_info); @@ -404,6 +397,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, * Calls H5Oget_info * INPUTS * object_id - Identifier for target object. + * fields - Flags specifying the fields to include in object_info. * OUTPUTS * object_info - Buffer in which to return object information. * @@ -415,16 +409,16 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, * SOURCE */ int_f -h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) +h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields) /******/ { int_f ret_value = 0; /* Return value */ - H5O_info_t Oinfo; - + H5O_info2_t Oinfo; + /* * Call H5Oinfo_by_name function. */ - if(H5Oget_info((hid_t)*object_id, &Oinfo) < 0) + if(H5Oget_info3((hid_t)*object_id, &Oinfo, (unsigned)*fields) < 0) HGOTO_DONE(FAIL); ret_value = fill_h5o_info_t_f(Oinfo,object_info); @@ -438,12 +432,12 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) * H5Ocopy_c * PURPOSE * Calls H5Ocopy - * INPUTS - * src_loc_id - Object identifier indicating the location of the source object to be copied - * src_name - Name of the source object to be copied + * INPUTS + * src_loc_id - Object identifier indicating the location of the source object to be copied + * src_name - Name of the source object to be copied * src_name_len - Length of src_name - * dst_loc_id - Location identifier specifying the destination - * dst_name - Name to be assigned to the new copy + * dst_loc_id - Location identifier specifying the destination + * dst_name - Name to be assigned to the new copy * dst_name_len - Length of dst_name * ocpypl_id - Object copy property list * lcpl_id - Link creation property list for the new hard link @@ -457,15 +451,15 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) */ int_f h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, - hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, - hid_t_f *ocpypl_id, hid_t_f *lcpl_id ) + hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, + hid_t_f *ocpypl_id, hid_t_f *lcpl_id ) /******/ { char *c_src_name = NULL; /* Buffer to hold C string */ char *c_dst_name = NULL; /* Buffer to hold C string */ - + int_f ret_value = 0; /* Return value */ - + /* * Convert FORTRAN name to C name */ @@ -477,8 +471,8 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, /* * Call H5Ocopy function. */ - if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name, - (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0) + if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name, + (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0) HGOTO_DONE(FAIL); done: @@ -503,6 +497,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, * idx - Iteration position at which to start * op - Callback function passing data regarding the link to the calling application * op_data - User-defined pointer to data required by the application for its processing of the link + * fields - Flags specifying the fields to include in object_info. * * OUTPUTS * idx - Position at which an interrupted iteration may be restarted @@ -516,7 +511,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, */ int_f h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, - H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ) + H5O_iterate2_t op, void *op_data, hid_t_f *lapl_id, int_f *fields ) /******/ { int_f ret_value = -1; /* Return value */ @@ -530,10 +525,10 @@ h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f HGOTO_DONE(FAIL); /* - * Call H5Ovisit + * Call H5Ovisit_by_name */ - func_ret_value = H5Ovisit_by_name( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, - op, op_data, (hid_t)*lapl_id); + func_ret_value = H5Ovisit_by_name3( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, + op, op_data, (unsigned)*fields, (hid_t)*lapl_id); ret_value = (int_f)func_ret_value; done: @@ -694,8 +689,8 @@ h5oset_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentlen) * Calls H5Oset_comment_by_name * INPUTS * object_id - Identifier of the target object. - * name - Name of the object whose comment is to be set or reset, - * specified as a path relative to loc_id. + * name - Name of the object whose comment is to be set or reset, + * specified as a path relative to loc_id. * namelen - Length of the name. * comment - The new comment. * commentlen - Length of the comment. @@ -762,15 +757,15 @@ h5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fc * SOURCE */ int_f -h5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, - int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) +h5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) /******/ { char *c_group_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; H5_index_t c_index_type; H5_iter_order_t c_order; - + /* * Convert FORTRAN string to C string */ @@ -823,13 +818,13 @@ h5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssi /* * Allocate buffer to hold comment name */ - + if(NULL == (c_comment = (char *)HDmalloc(c_commentsize))) HGOTO_DONE(FAIL); /* * Call H5Oget_comment function. - */ + */ if((*bufsize = (hssize_t_f)H5Oget_comment((hid_t)*object_id, c_comment, (size_t)*commentsize)) < 0) HGOTO_DONE(FAIL); @@ -867,8 +862,8 @@ h5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssi * SOURCE */ int_f -h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, - _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id) +h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, + _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id) /******/ { char *c_comment = NULL; /* Buffer to hold C string */ @@ -888,13 +883,13 @@ h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, /* * Allocate buffer to hold comment name */ - + if(NULL == (c_comment = (char *)HDmalloc(c_commentsize))) HGOTO_DONE(FAIL); /* * Call H5Oget_comment_by_name function. - */ + */ if((c_bufsize = H5Oget_comment_by_name((hid_t)*loc_id, c_name, c_comment, (size_t)*commentsize,(hid_t)*lapl_id )) < 0) HGOTO_DONE(FAIL); @@ -922,3 +917,41 @@ h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, return ret_value; } + +/****if* H5Of/h5otoken_cmp_c + * NAME + * h5otoken_cmp_c + * PURPOSE + * Calls H5Otoken_cmp + * INPUTS + * loc_id - Identifier of an object in the file / container. + * token1 - The first token to compare. + * token2 - The second token to compare. + * cmp_value - Whether the tokens are equal. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * Quincey Koziol + * January 10, 2019 + * SOURCE +*/ +int_f +h5otoken_cmp_c(hid_t_f *loc_id, H5O_token_t *token1, H5O_token_t *token2, + int_f *cmp_value_f) +/******/ +{ + int cmp_value; /* Token comparison result */ + int_f ret_value = 0; /* Return value */ + + /* Call H5Otoken_cmp function */ + cmp_value = 0; + if(H5Otoken_cmp((hid_t)*loc_id, token1, token2, &cmp_value) < 0) + HGOTO_DONE(FAIL); + + /* Set the comparison value to return */ + *cmp_value_f = cmp_value; + +done: + return ret_value; +} + diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index 243ec29..d3b02e5 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -44,7 +44,43 @@ MODULE H5O USE H5GLOBAL IMPLICIT NONE -!****t* H5T (F03)/h5o_info_t +!****t* H5O (F03)/h5o_info_t +! +! Fortran2003 Derived Type: +! + TYPE, BIND(C) :: h5o_info_t + INTEGER(C_LONG) :: fileno ! File number that object is located in + TYPE(H5O_TOKEN_T_F) :: token ! Token for object in file + INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) + INTEGER :: rc ! Reference count of object + + INTEGER, DIMENSION(8) :: atime ! Access time ! -- NOTE -- + INTEGER, DIMENSION(8) :: mtime ! Modification time ! Returns an integer array + INTEGER, DIMENSION(8) :: ctime ! Change time ! as specified in the Fortran + INTEGER, DIMENSION(8) :: btime ! Birth time ! intrinsic DATE_AND_TIME(VALUES) + + INTEGER(hsize_t) :: num_attrs ! # of attributes attached to object + END TYPE h5o_info_t + +! C interoperable structure for h5o_info_t. The Fortran derived type returns the time +! values as an integer array as specified in the Fortran intrinsic DATE_AND_TIME(VALUES). +! Whereas, this derived type does not. + + TYPE, BIND(C) :: c_h5o_info_t + INTEGER(C_LONG) :: fileno ! File number that object is located in + TYPE(H5O_TOKEN_T_F) :: token ! Token for object in file + INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) + INTEGER(C_INT) :: rc ! Reference count of object + + INTEGER(KIND=TIME_T) :: atime ! Access time + INTEGER(KIND=TIME_T) :: mtime ! Modify time + INTEGER(KIND=TIME_T) :: ctime ! Create time + INTEGER(KIND=TIME_T) :: btime ! Birth time + + INTEGER(hsize_t) :: num_attrs ! # of attributes attached to object + END TYPE c_h5o_info_t + +!****t* H5O (F03)/h5o_native_info_t ! ! Fortran2003 Derived Type: ! @@ -56,19 +92,28 @@ MODULE H5O END TYPE space_t TYPE, BIND(C) :: mesg_t - INTEGER(c_int64_t) :: present ! Flags to indicate presence of message type in header + INTEGER(c_int64_t) :: present ! Flags to indicate presence of message type in header INTEGER(c_int64_t) :: shared ! Flags to indicate message type is shared in header END TYPE mesg_t - + TYPE, BIND(C) :: hdr_t INTEGER :: version ! Version number of header format in file INTEGER :: nmesgs ! Number of object header messages INTEGER :: nchunks ! Number of object header chunks INTEGER :: flags ! Object header status flags - TYPE(space_t) :: space + TYPE(space_t) :: space TYPE(mesg_t) :: mesg END TYPE hdr_t + TYPE, BIND(C) :: c_hdr_t + INTEGER(C_INT) :: version ! Version number of header format in file + INTEGER(C_INT) :: nmesgs ! Number of object header messages + INTEGER(C_INT) :: nchunks ! Number of object header chunks + INTEGER(C_INT) :: flags ! Object header status flags + TYPE(space_t) :: space + TYPE(mesg_t) :: mesg + END TYPE c_hdr_t + ! Extra metadata storage for obj & attributes TYPE, BIND(C) :: H5_ih_info_t INTEGER(hsize_t) :: index_size ! btree and/or list @@ -79,24 +124,17 @@ MODULE H5O TYPE(H5_ih_info_t) :: obj ! v1/v2 B-tree & local/fractal heap for groups, B-tree for chunked datasets TYPE(H5_ih_info_t) :: attr ! v2 B-tree & heap for attributes ENDTYPE meta_size_t - - TYPE, BIND(C) :: h5o_info_t - INTEGER(C_LONG) :: fileno ! File number that object is located in - INTEGER(haddr_t) :: addr ! Object address in file - INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) - INTEGER :: rc ! Reference count of object - - INTEGER, DIMENSION(8) :: atime ! Access time ! -- NOTE -- - INTEGER, DIMENSION(8) :: mtime ! Modification time ! Returns an integer array - INTEGER, DIMENSION(8) :: ctime ! Change time ! as specified in the Fortran - INTEGER, DIMENSION(8) :: btime ! Birth time ! intrinsic DATE_AND_TIME(VALUES) - - INTEGER(hsize_t) :: num_attrs ! # of attributes attached to object + TYPE, BIND(C) :: h5o_native_info_t TYPE(hdr_t) :: hdr + TYPE(meta_size_t) :: meta_size + END TYPE h5o_native_info_t +! C interoperable structure for h5o_native_info_t. + TYPE, BIND(C) :: c_h5o_native_info_t + TYPE(c_hdr_t) :: hdr TYPE(meta_size_t) :: meta_size - END TYPE h5o_info_t + END TYPE c_h5o_native_info_t !***** @@ -261,55 +299,55 @@ CONTAINS END SUBROUTINE h5oclose_f ! -!****s* H5O/h5open_by_addr_f -! NAME -! h5oopen_by_addr_f +!****s* H5O/h5oopen_by_token_f +! NAME +! h5oopen_by_token_f ! ! PURPOSE -! Opens an object using its address within an HDF5 file. +! Opens an object using its token within an HDF5 file. ! -! Inputs: +! Inputs: ! loc_id - File or group identifier. -! addr - Object’s address in the file. +! token - Object’s token in the file. ! ! Outputs: ! obj_id - Object identifier for the opened object. ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! September 14, 2009 -! +! ! Fortran90 Interface: - SUBROUTINE h5oopen_by_addr_f(loc_id, addr, obj_id, hdferr) + SUBROUTINE h5oopen_by_token_f(loc_id, token, obj_id, hdferr) IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: loc_id - INTEGER(HADDR_T), INTENT(IN) :: addr - INTEGER(HID_T) , INTENT(OUT) :: obj_id - INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) :: loc_id + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token + INTEGER(HID_T) , INTENT(OUT) :: obj_id + INTEGER , INTENT(OUT) :: hdferr !***** INTERFACE - INTEGER FUNCTION h5oopen_by_addr_c(loc_id, addr, obj_id) BIND(C,NAME='h5oopen_by_addr_c') - IMPORT :: HID_T, HADDR_T + INTEGER FUNCTION h5oopen_by_token_c(loc_id, token, obj_id) BIND(C,NAME='h5oopen_by_token_c') + IMPORT :: HID_T, H5O_TOKEN_T_F IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id - INTEGER(HADDR_T), INTENT(IN) :: addr + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token INTEGER(HID_T), INTENT(OUT) :: obj_id - END FUNCTION h5oopen_by_addr_c + END FUNCTION h5oopen_by_token_c END INTERFACE - hdferr = h5oopen_by_addr_c(loc_id, addr, obj_id) + hdferr = h5oopen_by_token_c(loc_id, token, obj_id) - END SUBROUTINE h5oopen_by_addr_f + END SUBROUTINE h5oopen_by_token_f ! !****s* H5O/h5ocopy_f -! NAME -! h5ocopy_f +! NAME +! h5ocopy_f ! ! PURPOSE ! Copies an object in an HDF5 file. ! -! Inputs: +! Inputs: ! src_loc_id - Object identifier indicating the location of the source object to be copied. ! src_name - Name of the source object to be copied. ! dst_loc_id - Location identifier specifying the destination. @@ -319,13 +357,13 @@ CONTAINS ! ocpypl_id - Object copy property list. ! lcpl_id - Link creation property list for the new hard link. ! -! Outputs: +! Outputs: ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! March 14, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5ocopy_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr, ocpypl_id, lcpl_id) IMPLICIT NONE @@ -373,22 +411,22 @@ CONTAINS END SUBROUTINE h5ocopy_f !****s* H5O/h5odecr_refcount_f -! NAME +! NAME ! h5odecr_refcount_f ! ! PURPOSE -! Decrements an object reference count. +! Decrements an object reference count. ! -! Inputs: +! Inputs: ! object_id - Object identifier. ! -! Outputs: +! Outputs: ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 11, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5odecr_refcount_f(object_id, hdferr) IMPLICIT NONE @@ -404,33 +442,33 @@ CONTAINS END FUNCTION h5odecr_refcount_c END INTERFACE - hdferr = h5odecr_refcount_c(object_id) + hdferr = h5odecr_refcount_c(object_id) END SUBROUTINE h5odecr_refcount_f !****s* H5O/h5oexists_by_name_f -! NAME +! NAME ! h5oexists_by_name_f ! ! PURPOSE ! Determines whether a link resolves to an actual object. ! ! Inputs: -! loc_id - Identifier of the file or group to query. -! name - The name of the link to check. -! +! loc_id - Identifier of the file or group to query. +! name - The name of the link to check. +! ! ! Optional parameters: ! lapl_id - Link access property list identifier. ! -! Outputs: +! Outputs: ! link_exists - Existing link resolves to an object. ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 11, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oexists_by_name_f(loc_id, name, link_exists, hdferr, lapl_id) IMPLICIT NONE @@ -460,7 +498,7 @@ CONTAINS END INTERFACE namelen = LEN(name) - + lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id @@ -479,11 +517,11 @@ CONTAINS END SUBROUTINE h5oexists_by_name_f !****s* H5O/h5oget_comment_f -! NAME +! NAME ! h5oget_comment_f ! ! PURPOSE -! Retrieves comment for specified object. +! Retrieves comment for specified object. ! ! Inputs: ! obj_id - Identifier for the target object. @@ -491,21 +529,21 @@ CONTAINS ! Optional parameters: ! bufsize - Size of the comment buffer. ! -! Outputs: +! Outputs: ! comment - The comment. ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 11, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oget_comment_f(obj_id, comment, hdferr, bufsize) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: obj_id CHARACTER(LEN=*) , INTENT(OUT) :: comment INTEGER , INTENT(OUT) :: hdferr - INTEGER(HSSIZE_T), INTENT(OUT), OPTIONAL :: bufsize + INTEGER(HSSIZE_T), INTENT(OUT), OPTIONAL :: bufsize !***** INTEGER(SIZE_T) :: commentsize_default @@ -527,13 +565,13 @@ CONTAINS commentsize_default = LEN(comment) hdferr = h5oget_comment_c(obj_id, comment, commentsize_default, bufsize_default) - + IF(PRESENT(bufsize)) bufsize = bufsize_default END SUBROUTINE h5oget_comment_f !****s* H5O/h5oget_comment_by_name_f -! NAME +! NAME ! h5oget_comment_by_name_f ! ! PURPOSE @@ -541,20 +579,20 @@ CONTAINS ! ! Inputs: ! loc_id - Identifier of a file, group, dataset, or named datatype. -! name - Name of the object whose comment is to be retrieved, -! specified as a path relative to loc_id. +! name - Name of the object whose comment is to be retrieved, +! specified as a path relative to loc_id. ! ! Optional parameters: ! bufsize - Size of the comment buffer. ! -! Outputs: +! Outputs: ! comment - The comment. ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! July 6, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oget_comment_by_name_f(loc_id, name, comment, hdferr, bufsize, lapl_id) IMPLICIT NONE @@ -562,8 +600,8 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: name CHARACTER(LEN=*), INTENT(OUT) :: comment INTEGER , INTENT(OUT) :: hdferr - INTEGER(SIZE_T) , INTENT(OUT), OPTIONAL :: bufsize - INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER(SIZE_T) , INTENT(OUT), OPTIONAL :: bufsize + INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id !***** INTEGER(SIZE_T) :: commentsize_default @@ -594,28 +632,28 @@ CONTAINS hdferr = h5oget_comment_by_name_c(loc_id, name, name_size, & comment, commentsize_default, bufsize_default, lapl_id_default) - + IF(PRESENT(bufsize)) bufsize = bufsize_default END SUBROUTINE h5oget_comment_by_name_f !****s* H5O/h5oincr_refcount_f -! NAME +! NAME ! h5oincr_refcount_f ! ! PURPOSE ! Increments an object reference count. ! -! Inputs: +! Inputs: ! obj_id - Object identifier. ! -! Outputs: +! Outputs: ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 15, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oincr_refcount_f(obj_id, hdferr) IMPLICIT NONE @@ -631,7 +669,7 @@ CONTAINS END FUNCTION h5oincr_refcount_c END INTERFACE - hdferr = h5oincr_refcount_c(obj_id) + hdferr = h5oincr_refcount_c(obj_id) END SUBROUTINE h5oincr_refcount_f @@ -641,7 +679,7 @@ CONTAINS ! h5oopen_by_idx_f ! ! PURPOSE -! Open the nth object in a group. +! Open the nth object in a group. ! ! Inputs: ! loc_id - A file or group identifier. @@ -676,7 +714,7 @@ CONTAINS !***** INTEGER(SIZE_T) :: group_namelen INTEGER(HID_T) :: lapl_id_default - + INTERFACE INTEGER FUNCTION h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default) & BIND(C,NAME='h5oopen_by_idx_c') @@ -705,23 +743,23 @@ CONTAINS END SUBROUTINE H5Oopen_by_idx_f !****s* H5O/h5oset_comment_f -! NAME +! NAME ! h5oset_comment_f ! ! PURPOSE ! Sets comment for specified object. ! -! Inputs: +! Inputs: ! obj_id - Identifier of the target object. ! comment - The new comment. ! -! Outputs: +! Outputs: ! hdferr - Returns 0 if successful and -1 if fails. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 15, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oset_comment_f(obj_id, comment, hdferr) IMPLICIT NONE @@ -744,34 +782,34 @@ CONTAINS END INTERFACE commentlen = LEN(comment) - + hdferr = h5oset_comment_c(obj_id, comment, commentlen) END SUBROUTINE h5oset_comment_f !****s* H5O/h5oset_comment_by_name_f -! NAME +! NAME ! h5oset_comment_by_name_f ! ! PURPOSE -! Sets comment for specified object. +! Sets comment for specified object. ! -! Inputs: +! Inputs: ! loc_id - Identifier of a file, group, dataset, or named datatype. -! name - Name of the object whose comment is to be set or reset, -! specified as a path relative to loc_id. +! name - Name of the object whose comment is to be set or reset, +! specified as a path relative to loc_id. ! comment - The new comment. ! -! Outputs: +! Outputs: ! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: ! lapl_id - Link access property list identifier. ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! May 15, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5oset_comment_by_name_f(loc_id, name, comment, hdferr, lapl_id) IMPLICIT NONE @@ -805,7 +843,7 @@ CONTAINS lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id - + hdferr = h5oset_comment_by_name_c(loc_id, name, namelen, comment, commentlen, lapl_id_default) END SUBROUTINE h5oset_comment_by_name_f @@ -831,28 +869,34 @@ CONTAINS ! op_data - User-defined pointer to data required by the application for its processing of the group ! ! Outputs: -! return_value - returns the return value of the first operator that returns a positive value, or +! return_value - returns the return value of the first operator that returns a positive value, or ! zero if all members were processed with no operator returning non-zero. ! hdferr - Returns 0 if successful and -1 if fails +! +! Optional parameters: +! fields - Flags specifying the fields to include in object_info. +! ! AUTHOR ! M. Scot Breitenfeld ! November 19, 2008 ! ! Fortran2003 Interface: - SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr) + SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr, fields) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: object_id - INTEGER, INTENT(IN) :: index_type + INTEGER, INTENT(IN) :: index_type INTEGER, INTENT(IN) :: order TYPE(C_FUNPTR):: op TYPE(C_PTR) :: op_data INTEGER, INTENT(OUT) :: return_value INTEGER, INTENT(OUT) :: hdferr + INTEGER, INTENT(IN), OPTIONAL :: fields !***** + INTEGER :: fields_c INTERFACE - INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data) & + INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data, fields) & BIND(C, NAME='h5ovisit_c') IMPORT :: C_FUNPTR, C_PTR IMPORT :: HID_T @@ -862,10 +906,14 @@ CONTAINS INTEGER, INTENT(IN) :: order TYPE(C_FUNPTR), VALUE :: op TYPE(C_PTR), VALUE :: op_data + INTEGER, INTENT(IN) :: fields END FUNCTION h5ovisit_c END INTERFACE - return_value = h5ovisit_c(object_id, index_type, order, op, op_data) + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + + return_value = h5ovisit_c(object_id, index_type, order, op, op_data, fields_c) IF(return_value.GE.0)THEN hdferr = 0 @@ -884,36 +932,39 @@ CONTAINS ! Retrieves the metadata for an object, identifying the object by location and relative name. ! ! Inputs: -! loc_id - File or group identifier specifying location of group +! loc_id - File or group identifier specifying location of group ! in which object is located. ! name - Name of group, relative to loc_id. ! -! Outputs: +! Outputs: ! object_info - Buffer in which to return object information. ! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: ! lapl_id - Link access property list. +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld ! December 1, 2008 ! ! Fortran2003 Interface: - SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id) + SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id, fields) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default TYPE(C_PTR) :: ptr - + INTEGER :: fields_c + INTERFACE - INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info) & + INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info, fields) & BIND(C, NAME='h5oget_info_by_name_c') IMPORT :: c_char, c_ptr IMPORT :: HID_T, SIZE_T @@ -922,11 +973,14 @@ CONTAINS CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name INTEGER(SIZE_T) , INTENT(IN) :: namelen INTEGER(HID_T) , INTENT(IN) :: lapl_id_default - TYPE(C_PTR),VALUE :: object_info - + TYPE(C_PTR), VALUE :: object_info + INTEGER , INTENT(IN) :: fields END FUNCTION h5oget_info_by_name_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(name) lapl_id_default = H5P_DEFAULT_F @@ -934,7 +988,7 @@ CONTAINS ptr = C_LOC(object_info) - hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr) + hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr, fields_c) END SUBROUTINE H5Oget_info_by_name_f @@ -953,34 +1007,43 @@ CONTAINS ! object_info - Buffer in which to return object information. ! hdferr - Returns 0 if successful and -1 if fails. ! +! Optional parameters: +! fields - Flags specifying the fields to include in object_info. +! ! AUTHOR ! M. Scot Breitenfeld ! May 11, 2012 ! ! Fortran2003 Interface: - SUBROUTINE h5oget_info_f(object_id, object_info, hdferr) + SUBROUTINE h5oget_info_f(object_id, object_info, hdferr, fields) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: object_id TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr + INTEGER , INTENT(IN), OPTIONAL :: fields !***** TYPE(C_PTR) :: ptr - + INTEGER :: fields_c + INTERFACE - INTEGER FUNCTION h5oget_info_c(object_id, object_info) & + INTEGER FUNCTION h5oget_info_c(object_id, object_info, fields) & BIND(C, NAME='h5oget_info_c') IMPORT :: C_PTR IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: object_id TYPE(C_PTR), VALUE :: object_info + INTEGER, INTENT(IN) :: fields END FUNCTION h5oget_info_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + ptr = C_LOC(object_info) - hdferr = H5Oget_info_c(object_id, ptr) + hdferr = H5Oget_info_c(object_id, ptr, fields_c) END SUBROUTINE H5Oget_info_f @@ -993,19 +1056,20 @@ CONTAINS ! Retrieves the metadata for an object, identifying the object by an index position. ! ! Inputs: -! loc_id - File or group identifier specifying location of group +! loc_id - File or group identifier specifying location of group ! in which object is located. ! group_name - Name of group in which object is located. ! index_field - Index or field that determines the order. ! order - Order within field or index. ! n - Object for which information is to be returned ! -! Outputs: +! Outputs: ! object_info - Buffer in which to return object information. ! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: ! lapl_id - Link access property list. (Not currently used.) +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld @@ -1013,9 +1077,9 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, & - object_info, hdferr, lapl_id) + object_info, hdferr, lapl_id, fields) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: group_name @@ -1025,14 +1089,16 @@ CONTAINS TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default TYPE(C_PTR) :: ptr - + INTEGER :: fields_c + INTERFACE INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, & - index_field, order, n, lapl_id_default, object_info) BIND(C, NAME='h5oget_info_by_idx_c') + index_field, order, n, lapl_id_default, object_info, fields) BIND(C, NAME='h5oget_info_by_idx_c') IMPORT :: c_char, c_ptr, c_funptr IMPORT :: HID_T, SIZE_T, HSIZE_T INTEGER(HID_T) , INTENT(IN) :: loc_id @@ -1043,17 +1109,20 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: n INTEGER(HID_T) , INTENT(IN) :: lapl_id_default TYPE(C_PTR), VALUE :: object_info - + INTEGER, INTENT(IN) :: fields END FUNCTION h5oget_info_by_idx_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(group_name) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id ptr = C_LOC(object_info) - hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr) + hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr, fields_c) END SUBROUTINE H5Oget_info_by_idx_f @@ -1068,7 +1137,7 @@ CONTAINS ! ! Inputs: ! loc_id - Identifier of a file or group. -! object_name - Name of the object, generally relative to loc_id, that will serve as root of the iteration +! object_name - Name of the object, generally relative to loc_id, that will serve as root of the iteration ! index_type - Type of index; valid values include: ! H5_INDEX_NAME_F ! H5_INDEX_CRT_ORDER_F @@ -1080,12 +1149,13 @@ CONTAINS ! op_data - User-defined pointer to data required by the application for its processing of the group ! ! Outputs: -! return_value - Returns the return value of the first operator that returns a positive value, or +! return_value - Returns the return value of the first operator that returns a positive value, or ! zero if all members were processed with no operator returning non-zero. ! hdferr - Returns 0 if successful and -1 if fails ! ! Optional parameters: ! lapl_id - Link access property list identifier. +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld @@ -1093,11 +1163,11 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_data, & - return_value, hdferr, lapl_id) + return_value, hdferr, lapl_id, fields) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: object_name - INTEGER , INTENT(IN) :: index_type + INTEGER , INTENT(IN) :: index_type INTEGER , INTENT(IN) :: order TYPE(C_FUNPTR) :: op @@ -1105,14 +1175,16 @@ CONTAINS INTEGER , INTENT(OUT) :: return_value INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default + INTEGER :: fields_c INTERFACE INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id) BIND(C, NAME='h5ovisit_by_name_c') + op, op_data, lapl_id, fields) BIND(C, NAME='h5ovisit_by_name_c') IMPORT :: C_CHAR, C_PTR, C_FUNPTR IMPORT :: HID_T, SIZE_T IMPLICIT NONE @@ -1124,16 +1196,20 @@ CONTAINS TYPE(C_FUNPTR) , VALUE :: op TYPE(C_PTR) , VALUE :: op_data INTEGER(HID_T) , INTENT(IN) :: lapl_id + INTEGER , INTENT(IN) :: fields END FUNCTION h5ovisit_by_name_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(object_name) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id_default) + op, op_data, lapl_id_default, fields_c) IF(return_value.GE.0)THEN hdferr = 0 @@ -1143,5 +1219,50 @@ CONTAINS END SUBROUTINE h5ovisit_by_name_f +!****s* H5O/h5otoken_cmp_f +! NAME +! h5otoken_cmp_f +! +! PURPOSE +! Compare two tokens, which must be from the same file / containers. +! +! Inputs: +! loc_id - Identifier of an object in the file / container. +! token1 - The first token to compare. +! token2 - The second token to compare. +! +! Outputs: +! cmp_value - Returns 0 if tokens are equal, non-zero for unequal tokens. +! hdferr - Returns 0 if successful and -1 if fails. +! +! AUTHOR +! Quincey Koziol +! January 10, 2019 +! +! Fortran90 Interface: + SUBROUTINE h5otoken_cmp_f(loc_id, token1, token2, cmp_value, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: loc_id + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token1 ! First token + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token2 ! First token + INTEGER , INTENT(OUT) :: cmp_value + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5otoken_cmp_c(loc_id, token1, token2, cmp_value) BIND(C,NAME='h5otoken_cmp_c') + IMPORT :: HID_T, C_PTR, H5O_TOKEN_T_F + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token1 ! First token + TYPE(H5O_TOKEN_T_F), INTENT(IN) :: token2 ! First token + INTEGER, INTENT(OUT) :: cmp_value + + END FUNCTION h5otoken_cmp_c + END INTERFACE + + hdferr = h5otoken_cmp_c(loc_id, token1, token2, cmp_value) + + END SUBROUTINE h5otoken_cmp_f + END MODULE H5O diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index a114e8b..7cb3db8 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -488,12 +488,26 @@ h5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) * Removed extra length parameters EP 7/6/00 * SOURCE */ +#ifdef H5_NO_DEPRECATED_SYMBOLS +int_f +h5pget_version_c (hid_t_f H5_ATTR_UNUSED *prp_id, int_f * boot,int_f * freelist, int_f * stab, int_f *shhdr) +/******/ +{ + /* + * Fill in fake values [since we need a file ID to call H5Fget_info :-( -QAK ] + */ + *boot = (int_f)0; + *freelist = (int_f)0; + *stab = (int_f)0; + *shhdr = (int_f)0; + + return 0; +} +#else /* H5_NO_DEPRECATED_SYMBOLS */ int_f h5pget_version_c (hid_t_f *prp_id, int_f * boot,int_f * freelist, int_f * stab, int_f *shhdr) /******/ { - int ret_value = -1; -#ifndef H5_NO_DEPRECATED_SYMBOLS herr_t ret; unsigned c_boot; unsigned c_freelist; @@ -504,25 +518,16 @@ h5pget_version_c (hid_t_f *prp_id, int_f * boot,int_f * freelist, int_f * stab, * Call H5Pget_version function. */ ret = H5Pget_version((hid_t)*prp_id, &c_boot, &c_freelist, &c_stab, &c_shhdr); - if (ret < 0) return ret_value; + if (ret < 0) return -1; *boot = (int_f)c_boot; *freelist = (int_f)c_freelist; *stab = (int_f)c_stab; *shhdr = (int_f)c_shhdr; -#else /* H5_NO_DEPRECATED_SYMBOLS */ - /* - * Fill in fake values [since we need a file ID to call H5Fget_info :-( -QAK ] - */ - *boot = (int_f)0; - *freelist = (int_f)0; - *stab = (int_f)0; - *shhdr = (int_f)0; -#endif /* H5_NO_DEPRECATED_SYMBOLS */ - ret_value = 0; - return ret_value; + return 0; } +#endif /* H5_NO_DEPRECATED_SYMBOLS */ /****if* H5Pf/h5pget_userblock_c * NAME @@ -1826,7 +1831,7 @@ DONE: * Wednesday, February 23, 2000 * HISTORY * Changed type of 'offset' from int_f to off_t_f -- MSB January 9, 2012 - * + * * SOURCE */ int_f @@ -2638,7 +2643,7 @@ h5pget_hyper_vector_size_c ( hid_t_f *prp_id , size_t_f *size) * INPUTS * parent - property list class identifier * name - name of the new class - * name_len - lenght of the "name" buffer + * name_len - length of the "name" buffer * OUTPUTS * class - new class identifier * RETURNS @@ -3148,7 +3153,7 @@ h5pget_class_name_c(hid_t_f *cls, _fcd name, int_f *name_len) char *c_name; /* - * Call H5Pget_class_name function. c_name is allocated by the library, + * Call H5Pget_class_name function. c_name is allocated by the library, * has to be freed by application. */ if(NULL == (c_name = H5Pget_class_name((hid_t)*cls))) @@ -3211,7 +3216,7 @@ DONE: * plist - property list class identifier * name - name of the new property * name_len - length of the "name" buffer - * Output: + * Output: * value - property value * RETURNS * 0 on success, -1 on failure @@ -3415,8 +3420,8 @@ h5pset_family_offset_c ( hid_t_f *prp_id , hsize_t_f *offset) * mem_map - memory mapping array * memb_fapl - property list for each memory usage type * memb_name - array with members names - * len - array with the lenght of each name - * lenmax - lenght of the name a sdeclared in Fortran + * len - array with the length of each name + * lenmax - length of the name a sdeclared in Fortran * flag - flag allowing partila access when one of the files is missing * RETURNS * 0 on success, -1 on failure @@ -3537,12 +3542,12 @@ h5pset_fapl_multi_sc ( hid_t_f *prp_id , int_f *flag) * Call H5Pget_fapl_multi to set multi file dirver * INPUTS * prp_id - file_creation property list identifier - * lenmax - lenght of the name a sdeclared in Fortran + * lenmax - length of the name a sdeclared in Fortran * OUTPUTS * memb_map - memory mapping array * memb_fapl - property list for each memory usage type * memb_name - array with members names - * len - array with the lenght of each name + * len - array with the length of each name * flag - flag allowing partila access when one of the files is missing * RETURNS * 0 on success, -1 on failure @@ -4056,46 +4061,6 @@ h5pget_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags) ret_value = 0; return ret_value; } -/****if* H5Pf/h5pset_libver_bounds_c - * NAME - * h5pset_libver_bounds_c - * PURPOSE - * Calls H5Pset_libver_bounds - * - * INPUTS - * - * fapl_id - File access property list identifier - * low - The earliest version of the library that will be used for writing objects. - * high - The latest version of the library that will be used for writing objects. - * OUTPUTS - * - * - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * February 18, 2008 - * HISTORY - * - * SOURCE -*/ -int_f -h5pset_libver_bounds_c(hid_t_f *fapl_id, int_f *low, int_f *high ) -/******/ -{ - int ret_value = -1; - herr_t ret; - - /* - * Call H5Pset_libver_bounds function. - */ - ret = H5Pset_libver_bounds( (hid_t)*fapl_id, (H5F_libver_t)*low, (H5F_libver_t)*high ); - if (ret < 0) return ret_value; - - ret_value = 0; - return ret_value; -} - /****if* H5Pf/h5pset_link_creation_order_c * NAME * h5pset_link_creation_order_c @@ -5212,7 +5177,7 @@ h5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nby * * Inputs: * fapl_id - File access property list identifier - * buf_ptr - Pointer to the initial file image, + * buf_ptr - Pointer to the initial file image, * or NULL if no initial file image is desired * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired * @@ -5242,7 +5207,7 @@ h5pset_file_image_c(hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len) * Inputs: * fapl_id - File access property list identifier * Outputs: - * buf_ptr - Pointer to the initial file image, + * buf_ptr - Pointer to the initial file image, * or NULL if no initial file image is desired * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired * diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index b69d4d0..7e06cf3 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -9,7 +9,7 @@ ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. *S +! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * ! * ! This file is part of HDF5. The full HDF5 copyright notice, including * @@ -38,10 +38,18 @@ MODULE H5P - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL USE H5fortkit + PRIVATE h5pset_fapl_multi_l, h5pset_fapl_multi_s + PRIVATE h5pset_fill_value_integer, h5pset_fill_value_char, h5pset_fill_value_ptr + PRIVATE h5pget_fill_value_integer, h5pget_fill_value_char, h5pget_fill_value_ptr + PRIVATE h5pset_integer, h5pset_char, h5pset_ptr + PRIVATE h5pget_integer, h5pget_char, h5pget_ptr + PRIVATE h5pregister_integer, h5pregister_ptr + PRIVATE h5pinsert_integer, h5pinsert_char, h5pinsert_ptr + INTERFACE h5pset_fapl_multi_f MODULE PROCEDURE h5pset_fapl_multi_l MODULE PROCEDURE h5pset_fapl_multi_s @@ -133,7 +141,7 @@ MODULE H5P BIND(C, NAME='h5pget_c') IMPORT :: c_char, c_ptr IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name INTEGER :: name_len TYPE(C_PTR), VALUE :: value @@ -170,12 +178,12 @@ MODULE H5P CONTAINS -!****s* H5P/h5pcreate_f +!****s* H5P/h5pcreate_f ! NAME -! h5pcreate_f +! h5pcreate_f ! ! PURPOSE -! Creates a new property as an instance of a property +! Creates a new property as an instance of a property ! list class. ! ! INPUTS @@ -200,18 +208,18 @@ CONTAINS ! ! OUTPUTS ! prp_id - property list identifier -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 +! port). March 14, 2001 ! ! Fortran90 Interface: SUBROUTINE h5pcreate_f(class, prp_id, hdferr) @@ -230,15 +238,15 @@ CONTAINS END FUNCTION h5pcreate_c END INTERFACE - hdferr = h5pcreate_c(class, prp_id) + hdferr = h5pcreate_c(class, prp_id) END SUBROUTINE h5pcreate_f -!****s* H5P/h5pset_preserve_f +!****s* H5P/h5pset_preserve_f ! NAME -! h5pset_preserve_f +! h5pset_preserve_f ! ! PURPOSE -! Sets the dataset transfer property list status to +! Sets the dataset transfer property list status to ! TRUE or FALSE for initializing compound datatype ! members during write/read operations. ! @@ -254,20 +262,20 @@ CONTAINS ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! -! Datatype of the flag parameter is changed from +! port). March 14, 2001 +! +! Datatype of the flag parameter is changed from ! INTEGER to LOGICAL June 4, 2003 ! ! Fortran90 Interface: SUBROUTINE h5pset_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier LOGICAL, INTENT(IN) :: flag ! TRUE/FALSE flag to set the dataset ! transfer property for partila writing/reading ! compound datatype @@ -287,12 +295,12 @@ CONTAINS END INTERFACE flag_c = 0 IF(flag) flag_c = 1 - hdferr = h5pset_preserve_c(prp_id, flag_c) + hdferr = h5pset_preserve_c(prp_id, flag_c) END SUBROUTINE h5pset_preserve_f -!****s* H5P/h5pget_preserve_f +!****s* H5P/h5pget_preserve_f ! NAME -! h5pget_preserve_f +! h5pget_preserve_f ! ! PURPOSE ! Checks status of the dataset transfer property list. @@ -302,26 +310,26 @@ CONTAINS ! ! OUTPUTS ! flag - status flag -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 14, 2001 -! -! Datatype of the flag parameter is changed from -! INTEGER to LOGICAL -! June 4, 2003 -! +! +! Datatype of the flag parameter is changed from +! INTEGER to LOGICAL +! June 4, 2003 +! ! Fortran90 Interface: SUBROUTINE h5pget_preserve_f(prp_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier LOGICAL, INTENT(OUT) :: flag ! TRUE/FALSE flag. Shows status of the dataset's ! transfer property for partial writing/reading ! compound datatype @@ -339,15 +347,15 @@ CONTAINS INTEGER :: flag_c END FUNCTION h5pget_preserve_c END INTERFACE - - hdferr = h5pget_preserve_c(prp_id, flag_c) + + hdferr = h5pget_preserve_c(prp_id, flag_c) flag = .FALSE. IF(flag_c .EQ. 1) flag = .TRUE. END SUBROUTINE h5pget_preserve_f -!****s* H5P/h5pget_class_f +!****s* H5P/h5pget_class_f ! NAME -! h5pget_class_f +! h5pget_class_f ! ! PURPOSE ! Returns the property list class for a property list. @@ -357,24 +365,24 @@ CONTAINS ! ! OUTPUTS ! classtype - property list class -! hdferr: - error code +! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 +! port). March 14, 2001 ! ! Fortran90 Interface: SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(HID_T), INTENT(OUT) :: classtype ! The type of the property list + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(OUT) :: classtype ! The type of the property list ! to be created. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -386,42 +394,42 @@ CONTAINS IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HID_T), INTENT(OUT) :: classtype + INTEGER(HID_T), INTENT(OUT) :: classtype END FUNCTION h5pget_class_c END INTERFACE - hdferr = h5pget_class_c(prp_id, classtype) + hdferr = h5pget_class_c(prp_id, classtype) END SUBROUTINE h5pget_class_f -!****s* H5P/h5pcopy_f +!****s* H5P/h5pcopy_f ! NAME -! h5pcopy_f +! h5pcopy_f ! ! PURPOSE -! Copies an existing property list to create a new +! Copies an existing property list to create a new ! property list ! ! INPUTS ! prp_id - property list identifier ! OUTPUTS ! new_prp_id - new property list identifier -! hdferr: - error code +! hdferr: - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 14, 2001 ! ! Fortran90 Interface: SUBROUTINE h5pcopy_f(prp_id, new_prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(OUT) :: new_prp_id ! Identifier of property list INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -436,38 +444,38 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: new_prp_id END FUNCTION h5pcopy_c END INTERFACE - + hdferr = h5pcopy_c(prp_id, new_prp_id) END SUBROUTINE h5pcopy_f -!****s* H5P/h5pclose_f +!****s* H5P/h5pclose_f ! NAME -! h5pclose_f +! h5pclose_f ! ! PURPOSE -! Terminates access to a property list. +! Terminates access to a property list. ! ! INPUTS -! prp_id - identifier of the property list to -! terminate access to. +! prp_id - identifier of the property list to +! terminate access to. ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pclose_f(prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -476,45 +484,45 @@ CONTAINS BIND(C,NAME='h5pclose_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id END FUNCTION h5pclose_c END INTERFACE - + hdferr = h5pclose_c(prp_id) END SUBROUTINE h5pclose_f -!****s* H5P/h5pset_chunk_f +!****s* H5P/h5pset_chunk_f ! NAME -! h5pset_chunk_f +! h5pset_chunk_f ! ! PURPOSE -! Sets the size of the chunks used to store -! a chunked layout dataset. +! Sets the size of the chunks used to store +! a chunked layout dataset. ! ! INPUTS ! prp_id - datatset creation property list identifier ! ndims - number of dimensions for each chunk ! dims - array with dimension sizes for each chunk ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions - INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(IN) :: dims + INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(IN) :: dims ! Array containing sizes of ! chunk dimensions INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -530,16 +538,16 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(IN) :: dims END FUNCTION h5pset_chunk_c END INTERFACE - + hdferr = h5pset_chunk_c(prp_id, ndims, dims) END SUBROUTINE h5pset_chunk_f -!****s* H5P/h5pget_chunk_f +!****s* H5P/h5pget_chunk_f ! NAME -! h5pget_chunk_f +! h5pget_chunk_f ! ! PURPOSE -! Retrieves the size of chunks for the raw data of a +! Retrieves the size of chunks for the raw data of a ! chunked layout dataset ! ! INPUTS @@ -547,26 +555,26 @@ CONTAINS ! ndims - size of dims array ! OUTPUTS ! dims - array with dimension sizes for each chunk -! hdferr - error code +! hdferr - error code ! Success: number of chunk dimensions ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_chunk_f(prp_id, ndims, dims, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions to ! to return - INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(OUT) :: dims + INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(OUT) :: dims ! Array containing sizes of ! chunk dimensions INTEGER, INTENT(OUT) :: hdferr ! Error code: @@ -588,19 +596,19 @@ CONTAINS hdferr = h5pget_chunk_c(prp_id, ndims, dims) END SUBROUTINE h5pget_chunk_f -!****s* H5P/h5pset_deflate_f +!****s* H5P/h5pset_deflate_f ! NAME -! h5pset_deflate_f +! h5pset_deflate_f ! ! PURPOSE -! Sets compression method and compression level. +! Sets compression method and compression level. ! ! INPUTS ! prp_id - property list identifier ! level - compression level ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! @@ -609,15 +617,15 @@ CONTAINS ! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 14, 2001 -! +! ! Fortran90 Interface: SUBROUTINE h5pset_deflate_f(prp_id, level, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(IN) :: level ! Compression level + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: level ! Compression level INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -635,15 +643,15 @@ CONTAINS END FUNCTION h5pset_deflate_c END INTERFACE hdferr = h5pset_deflate_c(prp_id, level) - + END SUBROUTINE h5pset_deflate_f -!****s* H5P/h5pget_version_f +!****s* H5P/h5pget_version_f ! NAME -! h5pget_version_f +! h5pget_version_f ! ! PURPOSE -! Retrieves the version information of various objects +! Retrieves the version information of various objects ! for a file creation property list ! ! INPUTS @@ -653,24 +661,24 @@ CONTAINS ! freelist - global freelist version number ! stab - symbol table version number ! shhdr - shared object header version number -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! -! Fortran90 Interface: +! port). March 14, 2001 +! +! Fortran90 Interface: SUBROUTINE h5pget_version_f(prp_id, boot, freelist, & stab, shhdr, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, DIMENSION(:), INTENT(OUT) :: boot ! Array to put boot ! block version number INTEGER, DIMENSION(:), INTENT(OUT) :: freelist ! Array to put global @@ -690,19 +698,19 @@ CONTAINS IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, DIMENSION(*), INTENT(OUT) :: boot - INTEGER, DIMENSION(*), INTENT(OUT) :: freelist + INTEGER, DIMENSION(*), INTENT(OUT) :: boot + INTEGER, DIMENSION(*), INTENT(OUT) :: freelist INTEGER, DIMENSION(*), INTENT(OUT) :: stab INTEGER, DIMENSION(*), INTENT(OUT) :: shhdr END FUNCTION h5pget_version_c END INTERFACE - + hdferr = h5pget_version_c(prp_id, boot, freelist, stab, shhdr) END SUBROUTINE h5pget_version_f -!****s* H5P/h5pset_userblock_f +!****s* H5P/h5pset_userblock_f ! NAME -! h5pset_userblock_f +! h5pset_userblock_f ! ! PURPOSE ! Sets user block size @@ -712,24 +720,24 @@ CONTAINS ! size - size of the user-block in bytes ! ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 +! port). March 14, 2001 ! ! Fortran90 Interface: SUBROUTINE h5pset_userblock_f (prp_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(HSIZE_T), INTENT(IN) :: size ! Size of the user-block in bytes + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: size ! Size of the user-block in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -746,38 +754,38 @@ CONTAINS hdferr = h5pset_userblock_c(prp_id, size) END SUBROUTINE h5pset_userblock_f -!****s* H5P/h5pget_userblock_f +!****s* H5P/h5pget_userblock_f ! NAME -! h5pget_userblock_f +! h5pget_userblock_f ! ! PURPOSE ! Gets user block size. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! OUTPUTS -! +! ! block_size - size of the user block in bytes -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_userblock_f(prp_id, block_size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(HSIZE_T), INTENT(OUT) :: block_size ! Size of the - ! user-block in bytes + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(OUT) :: block_size ! Size of the + ! user-block in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -793,41 +801,41 @@ CONTAINS hdferr = h5pget_userblock_c(prp_id, block_size) END SUBROUTINE h5pget_userblock_f -!****s* H5P/h5pset_sizes_f +!****s* H5P/h5pset_sizes_f ! NAME -! h5pset_sizes_f +! h5pset_sizes_f ! ! PURPOSE -! Sets the byte size of the offsets and lengths used +! Sets the byte size of the offsets and lengths used ! to address objects in an HDF5 file. ! ! INPUTS ! prp_id - file creation property list identifier -! sizeof_addr - size of an object offset in bytes +! sizeof_addr - size of an object offset in bytes ! sizeof_size - size of an object length in bytes ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_sizes_f (prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(SIZE_T), INTENT(IN) :: sizeof_addr ! Size of an object - ! offset in bytes - INTEGER(SIZE_T), INTENT(IN) :: sizeof_size ! Size of an object - ! length in bytes + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), INTENT(IN) :: sizeof_addr ! Size of an object + ! offset in bytes + INTEGER(SIZE_T), INTENT(IN) :: sizeof_size ! Size of an object + ! length in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -836,50 +844,50 @@ CONTAINS BIND(C,NAME='h5pset_sizes_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER(SIZE_T), INTENT(IN) :: sizeof_addr INTEGER(SIZE_T), INTENT(IN) :: sizeof_size END FUNCTION h5pset_sizes_c END INTERFACE - + hdferr = h5pset_sizes_c(prp_id, sizeof_addr, sizeof_size) END SUBROUTINE h5pset_sizes_f -!****s* H5P/h5pget_sizes_f +!****s* H5P/h5pget_sizes_f ! NAME -! h5pget_sizes_f +! h5pget_sizes_f ! ! PURPOSE -! Retrieves the size of the offsets and lengths used +! Retrieves the size of the offsets and lengths used ! in an HDF5 file ! ! INPUTS ! prp_id - file creation property list identifier ! OUTPUTS -! -! sizeof_addr - size of an object offset in bytes +! +! sizeof_addr - size of an object offset in bytes ! sizeof_size - size of an object length in bytes -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_sizes_f(prp_id, sizeof_addr, sizeof_size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: sizeof_addr ! Size of an object - ! offset in bytes + ! offset in bytes INTEGER(SIZE_T), INTENT(OUT) :: sizeof_size ! Size of an object - ! length in bytes + ! length in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -888,49 +896,49 @@ CONTAINS BIND(C,NAME='h5pget_sizes_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER(SIZE_T), INTENT(OUT) :: sizeof_addr INTEGER(SIZE_T), INTENT(OUT) :: sizeof_size END FUNCTION h5pget_sizes_c END INTERFACE - + hdferr = h5pget_sizes_c(prp_id, sizeof_addr, sizeof_size) END SUBROUTINE h5pget_sizes_f -!****s* H5P/h5pset_sym_k_f +!****s* H5P/h5pset_sym_k_f ! NAME -! h5pset_sym_k_f +! h5pset_sym_k_f ! ! PURPOSE -! Sets the size of parameters used to control the +! Sets the size of parameters used to control the !symbol table nodes ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! ik - symbol table tree rank ! lk - symbol table node size ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_sym_k_f (prp_id, ik, lk, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(IN) :: ik ! Symbol table tree rank - INTEGER, INTENT(IN) :: lk ! Symbol table node size + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: ik ! Symbol table tree rank + INTEGER, INTENT(IN) :: lk ! Symbol table node size INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -939,46 +947,46 @@ CONTAINS BIND(C,NAME='h5pset_sym_k_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER, INTENT(IN) :: ik INTEGER, INTENT(IN) :: lk END FUNCTION h5pset_sym_k_c END INTERFACE - + hdferr = h5pset_sym_k_c(prp_id, ik, lk) END SUBROUTINE h5pset_sym_k_f -!****s* H5P/h5pget_sym_k_f +!****s* H5P/h5pget_sym_k_f ! NAME -! h5pget_sym_k_f +! h5pget_sym_k_f ! ! PURPOSE ! Retrieves the size of the symbol table B-tree 1/2 rank -! and the symbol table leaf node 1/2 size. +! and the symbol table leaf node 1/2 size. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! OUTPUTS -! +! ! ik - symbol table tree 1/2 rank ! lk - symbol table node 1/2 size -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_sym_k_f(prp_id, ik, lk, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: ik ! Symbol table tree rank INTEGER, INTENT(OUT) :: lk ! Symbol table node size INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -989,45 +997,45 @@ CONTAINS BIND(C,NAME='h5pget_sym_k_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER, INTENT(OUT) :: ik INTEGER, INTENT(OUT) :: lk END FUNCTION h5pget_sym_k_c END INTERFACE - + hdferr = h5pget_sym_k_c(prp_id, ik, lk) END SUBROUTINE h5pget_sym_k_f -!****s* H5P/h5pset_istore_k_f +!****s* H5P/h5pset_istore_k_f ! NAME -! h5pset_istore_k_f +! h5pset_istore_k_f ! ! PURPOSE -! Sets the size of the parameter used to control the +! Sets the size of the parameter used to control the ! B-trees for indexing chunked datasets ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! ik - 1/2 rank of chunked storage B-tree ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_istore_k_f (prp_id, ik, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: ik ! 1/2 rank of chunked storage B-tree INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1041,40 +1049,40 @@ CONTAINS INTEGER, INTENT(IN) :: ik END FUNCTION h5pset_istore_k_c END INTERFACE - + hdferr = h5pset_istore_k_c(prp_id, ik) END SUBROUTINE h5pset_istore_k_f -!****s* H5P/h5pget_istore_k_f +!****s* H5P/h5pget_istore_k_f ! NAME -! h5pget_istore_k_f +! h5pget_istore_k_f ! ! PURPOSE -! Queries the 1/2 rank of an indexed storage B-tree. +! Queries the 1/2 rank of an indexed storage B-tree. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! OUTPUTS -! +! ! ik - 1/2 rank of chunked storage B-tree -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_istore_k_f(prp_id, ik, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: ik ! 1/2 rank of chunked storage B-tree INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1088,41 +1096,41 @@ CONTAINS INTEGER, INTENT(OUT) :: ik END FUNCTION h5pget_istore_k_c END INTERFACE - + hdferr = h5pget_istore_k_c(prp_id, ik) END SUBROUTINE h5pget_istore_k_f -!****s* H5P/h5pget_driver_f +!****s* H5P/h5pget_driver_f ! NAME -! h5pget_driver_f +! h5pget_driver_f ! ! PURPOSE -! Returns low-lever driver identifier. +! Returns low-lever driver identifier. ! ! INPUTS -! -! prp_id - file access or data transfer property -! list identifier. +! +! prp_id - file access or data transfer property +! list identifier. ! OUTPUTS -! +! ! driver - low-level driver identifier -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_driver_f(prp_id, driver, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HID_T), INTENT(OUT) :: driver ! Low-level file driver identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1136,39 +1144,39 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: driver END FUNCTION h5pget_driver_c END INTERFACE - + hdferr = h5pget_driver_c(prp_id, driver) END SUBROUTINE h5pget_driver_f -!****s* H5P/h5pset_fapl_stdio_f +!****s* H5P/h5pset_fapl_stdio_f ! NAME -! h5pset_fapl_stdio_f +! h5pset_fapl_stdio_f ! ! PURPOSE -! Sets the standard I/O driver. +! Sets the standard I/O driver. ! ! INPUTS -! +! ! prp_id - file access property list identifier ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_stdio_f (prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -1180,34 +1188,34 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: prp_id END FUNCTION h5pset_fapl_stdio_c END INTERFACE - + hdferr = h5pset_fapl_stdio_c(prp_id) END SUBROUTINE h5pset_fapl_stdio_f -!****s* H5P/h5pget_stdio_f +!****s* H5P/h5pget_stdio_f ! NAME -! h5pget_stdio_f +! h5pget_stdio_f ! ! PURPOSE ! NOT AVAILABLE ! ! INPUTS -! +! ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! SOURCE ! SUBROUTINE h5pget_stdio_f (prp_id, io, hdferr) ! @@ -1223,35 +1231,35 @@ CONTAINS ! hdferr = h5pget_stdio_c(prp_id, io) ! END SUBROUTINE h5pget_stdio_f -!****s* H5P/h5pset_fapl_sec2_f +!****s* H5P/h5pset_fapl_sec2_f ! NAME -! h5pset_fapl_sec2_f +! h5pset_fapl_sec2_f ! ! PURPOSE -! Sets the sec2 driver. +! Sets the sec2 driver. ! ! INPUTS -! +! ! prp_id - file access property list identifier ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_sec2_f (prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -1260,38 +1268,38 @@ CONTAINS BIND(C,NAME='h5pset_fapl_sec2_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier END FUNCTION h5pset_fapl_sec2_c END INTERFACE - + hdferr = h5pset_fapl_sec2_c(prp_id) END SUBROUTINE h5pset_fapl_sec2_f -!****s* H5P/h5pget_sec2_f +!****s* H5P/h5pget_sec2_f ! NAME -! h5pget_sec2_f +! h5pget_sec2_f ! ! PURPOSE ! NOT AVAILABLE ! ! INPUTS -! +! ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! -! SOURCE! SUBROUTINE h5pget_sec2_f (prp_id, sec2, hdferr) +! port). March 14, 2001 +! +! SOURCE! SUBROUTINE h5pget_sec2_f (prp_id, sec2, hdferr) ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier ! INTEGER, INTENT(OUT) :: sec2 ! value indicates whether the file @@ -1304,37 +1312,37 @@ CONTAINS ! hdferr = h5pget_sec2_c(prp_id, sec2) ! END SUBROUTINE h5pget_sec2_f -!****s* H5P/h5pset_alignment_f +!****s* H5P/h5pset_alignment_f ! NAME -! h5pset_alignment_f +! h5pset_alignment_f ! ! PURPOSE -! Sets alignment properties of a file access property list. +! Sets alignment properties of a file access property list. ! ! INPUTS -! +! ! prp_id - file access property list identifier -! threshold - threshold value +! threshold - threshold value ! alignment - alignment value ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: threshold ! Threshold value INTEGER(HSIZE_T), INTENT(IN) :: alignment ! alignment value INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1350,41 +1358,41 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: alignment END FUNCTION h5pset_alignment_c END INTERFACE - + hdferr = h5pset_alignment_c(prp_id, threshold, alignment) END SUBROUTINE h5pset_alignment_f -!****s* H5P/h5pget_alignment_f +!****s* H5P/h5pget_alignment_f ! NAME -! h5pget_alignment_f +! h5pget_alignment_f ! ! PURPOSE -! Retrieves the current settings for alignment -! properties from a file access property list. +! Retrieves the current settings for alignment +! properties from a file access property list. ! ! INPUTS ! prp_id - file access property list identifier ! ! OUTPUTS -! threshold - threshold value +! threshold - threshold value ! alignment - alignment value -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_alignment_f(prp_id, threshold, alignment, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: threshold ! Threshold value INTEGER(HSIZE_T), INTENT(OUT) :: alignment ! alignment value INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1400,44 +1408,44 @@ CONTAINS INTEGER(HSIZE_T), INTENT(OUT) :: alignment END FUNCTION h5pget_alignment_c END INTERFACE - + hdferr = h5pget_alignment_c(prp_id, threshold, alignment) END SUBROUTINE h5pget_alignment_f -!****s* H5P/h5pset_fapl_core_f +!****s* H5P/h5pset_fapl_core_f ! NAME -! h5pset_fapl_core_f +! h5pset_fapl_core_f ! ! PURPOSE -! Modifies the file access property list to use the -! H5FD_CORE driver. +! Modifies the file access property list to use the +! H5FD_CORE driver. ! ! INPUTS ! prp_id - file access property list identifier -! increment - size, in bytes, of memory increments -! backing_store - boolean flag indicating whether to write -! the file contents to disk when the file is closed. +! increment - size, in bytes, of memory increments +! backing_store - boolean flag indicating whether to write +! the file contents to disk when the file is closed. ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(IN) :: increment ! File block size in bytes. LOGICAL, INTENT(IN) :: backing_store ! Flag to indicate that - ! entire file contents are flushed to a file + ! entire file contents are flushed to a file ! with the same name as this core file. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1448,9 +1456,9 @@ CONTAINS BIND(C,NAME='h5pset_fapl_core_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(SIZE_T), INTENT(IN) :: increment - INTEGER :: backing_store_flag + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(SIZE_T), INTENT(IN) :: increment + INTEGER :: backing_store_flag END FUNCTION h5pset_fapl_core_c END INTERFACE backing_store_flag = 0 @@ -1458,96 +1466,96 @@ CONTAINS hdferr = h5pset_fapl_core_c(prp_id, increment, backing_store_flag) END SUBROUTINE h5pset_fapl_core_f -!****s* H5P/h5pget_fapl_core_f +!****s* H5P/h5pget_fapl_core_f ! NAME -! h5pget_fapl_core_f +! h5pget_fapl_core_f ! ! PURPOSE -! Queries core file driver properties. +! Queries core file driver properties. ! ! INPUTS ! prp_id - file access property list identifier ! OUTPUTS -! -! increment - size, in bytes, of memory increments -! backing_store - boolean flag indicating whether to write -! the file contents to disk when the file is closed. -! hdferr - error code +! +! increment - size, in bytes, of memory increments +! backing_store - boolean flag indicating whether to write +! the file contents to disk when the file is closed. +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_fapl_core_f(prp_id, increment, backing_store, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: increment ! File block size in bytes. LOGICAL, INTENT(OUT) :: backing_store ! Flag to indicate that - ! entire file contents are flushed to a file + ! entire file contents are flushed to a file ! with the same name as this core file. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** - INTEGER :: backing_store_flag + INTEGER :: backing_store_flag INTERFACE INTEGER FUNCTION h5pget_fapl_core_c(prp_id, increment, backing_store_flag) & BIND(C,NAME='h5pget_fapl_core_c') IMPORT :: HID_T,SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(SIZE_T), INTENT(OUT) :: increment - INTEGER :: backing_store_flag + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(SIZE_T), INTENT(OUT) :: increment + INTEGER :: backing_store_flag END FUNCTION h5pget_fapl_core_c END INTERFACE - + hdferr = h5pget_fapl_core_c(prp_id, increment, backing_store_flag) backing_store =.FALSE. IF (backing_store_flag .EQ. 1) backing_store =.TRUE. END SUBROUTINE h5pget_fapl_core_f -!****s* H5P/ h5pset_fapl_family_f +!****s* H5P/ h5pset_fapl_family_f ! NAME -! h5pset_fapl_family_f +! h5pset_fapl_family_f ! ! PURPOSE -! Sets the file access property list to use the family driver. +! Sets the file access property list to use the family driver. ! ! INPUTS ! prp_id - file access property list identifier -! memb_size - size in bytes of each file member -! memb_plist - identifier of the file access property +! memb_size - size in bytes of each file member +! memb_plist - identifier of the file access property ! list to be used for each family member ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: memb_size ! Logical size, in bytes, ! of each family member - INTEGER(HID_T), INTENT(IN) :: memb_plist ! Identifier of the file - ! access property list for + INTEGER(HID_T), INTENT(IN) :: memb_plist ! Identifier of the file + ! access property list for ! each member of the family INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1566,39 +1574,39 @@ CONTAINS hdferr = h5pset_fapl_family_c(prp_id, memb_size, memb_plist) END SUBROUTINE h5pset_fapl_family_f -!****s* H5P/h5pget_fapl_family_f +!****s* H5P/h5pget_fapl_family_f ! NAME -! h5pget_fapl_family_f +! h5pget_fapl_family_f ! ! PURPOSE -! Returns file access property list information. +! Returns file access property list information. ! ! INPUTS ! prp_id - file access property list identifier ! OUTPUTS -! memb_size - size in bytes of each file member -! memb_plist - identifier of the file access property +! memb_size - size in bytes of each file member +! memb_plist - identifier of the file access property ! list to be used for each family member -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_fapl_family_f(prp_id, memb_size, memb_plist , hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: memb_size ! Logical size, in bytes, ! of each family member - INTEGER(HID_T), INTENT(OUT) :: memb_plist ! Identifier of the file - ! access property list for + INTEGER(HID_T), INTENT(OUT) :: memb_plist ! Identifier of the file + ! access property list for ! each member of the family INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1613,52 +1621,52 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: memb_plist END FUNCTION h5pget_fapl_family_c END INTERFACE - + hdferr = h5pget_fapl_family_c(prp_id, memb_size, memb_plist) END SUBROUTINE h5pget_fapl_family_f -!****s* H5P/h5pset_cache_f +!****s* H5P/h5pset_cache_f ! NAME -! h5pset_cache_f +! h5pset_cache_f ! ! PURPOSE -! Sets the meta data cache and raw data chunk +! Sets the meta data cache and raw data chunk ! cache parameters ! ! INPUTS -! +! ! prp_id - file access property list identifier -! mdc_nelmts - number of elements (objects) in the meta -! data cache -! rdcc_nelmts - number of elements (objects) in the raw -! data chunk cache -! rdcc_nbytes - total size of the raw data chunk cache, in bytes +! mdc_nelmts - number of elements (objects) in the meta +! data cache +! rdcc_nelmts - number of elements (objects) in the raw +! data chunk cache +! rdcc_nbytes - total size of the raw data chunk cache, in bytes ! rdcc_w0 - preemption policy (0 or 1) ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_cache_f(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: mdc_nelmts ! Number of elements (objects) ! in the meta data cache INTEGER(SIZE_T), INTENT(IN) :: rdcc_nelmts ! Number of elements (objects) ! in the meta data cache - INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes ! Total size of the raw data - ! chunk cache, in bytes + INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes ! Total size of the raw data + ! chunk cache, in bytes REAL, INTENT(IN) :: rdcc_w0 ! Preemption policy INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1669,8 +1677,8 @@ CONTAINS IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: mdc_nelmts - INTEGER(SIZE_T), INTENT(IN) :: rdcc_nelmts + INTEGER, INTENT(IN) :: mdc_nelmts + INTEGER(SIZE_T), INTENT(IN) :: rdcc_nelmts INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes REAL, INTENT(IN) :: rdcc_w0 END FUNCTION h5pset_cache_c @@ -1679,50 +1687,50 @@ CONTAINS hdferr = h5pset_cache_c(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0 ) END SUBROUTINE h5pset_cache_f -!****s* H5P/h5pget_cache_f +!****s* H5P/h5pget_cache_f ! NAME -! h5pget_cache_f +! h5pget_cache_f ! ! PURPOSE -! Queries the meta data cache and raw data chunk cache -! parameters. +! Queries the meta data cache and raw data chunk cache +! parameters. ! ! INPUTS ! prp_id - file access property list identifier ! ! OUTPUTS -! mdc_nelmts - number of elements (objects) in the meta -! data cache -! rdcc_nelmts - number of elements (objects) in the raw -! data chunk cache -! rdcc_nbytes - total size of the raw data chunk cache, in bytes +! mdc_nelmts - number of elements (objects) in the meta +! data cache +! rdcc_nelmts - number of elements (objects) in the raw +! data chunk cache +! rdcc_nbytes - total size of the raw data chunk cache, in bytes ! rdcc_w0 - preemption policy (0 or 1) -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 +! port). March 14, 2001 ! ! Bug fix: type of the rdcc_nelmts parameter should be INTEGER -! instead of INTEGER(SIZE_T) October 10, 2003 -! +! instead of INTEGER(SIZE_T) October 10, 2003 +! ! Fortran90 Interface: SUBROUTINE h5pget_cache_f(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: mdc_nelmts ! Number of elements (objects) ! in the meta data cache INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nelmts ! Number of elements (objects) ! in the meta data cache - INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes ! Total size of the raw data - ! chunk cache, in bytes + INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes ! Total size of the raw data + ! chunk cache, in bytes REAL, INTENT(OUT) :: rdcc_w0 ! Preemption policy INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1733,58 +1741,58 @@ CONTAINS IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(OUT) :: mdc_nelmts - INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nelmts + INTEGER, INTENT(OUT) :: mdc_nelmts + INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nelmts INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes REAL, INTENT(OUT) :: rdcc_w0 END FUNCTION h5pget_cache_c END INTERFACE - + hdferr = h5pget_cache_c(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0 ) END SUBROUTINE h5pget_cache_f -!****s* H5P/h5pset_fapl_split_f +!****s* H5P/h5pset_fapl_split_f ! NAME -! h5pset_fapl_split_f +! h5pset_fapl_split_f ! ! PURPOSE -! Emulates the old split file driver. +! Emulates the old split file driver. ! ! INPUTS -! +! ! prp_id - file access property list identifier -! meta_ext - name of the extension for the metafile +! meta_ext - name of the extension for the metafile ! filename -! meta_plist - identifier of the meta file access property +! meta_plist - identifier of the meta file access property ! list ! raw_ext - name extension for the raw file filename ! raw_plist - identifier of the raw file access property list ! ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_split_f(prp_id, meta_ext, meta_plist, raw_ext, raw_plist, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: meta_ext ! Name of the extension for ! the metafile filename INTEGER(HID_T), INTENT(IN) :: meta_plist ! Identifier of the meta file ! access property list CHARACTER(LEN=*), INTENT(IN) :: raw_ext ! Name extension for the raw file filename - INTEGER(HID_T), INTENT(IN) :: raw_plist ! Identifier of the raw file + INTEGER(HID_T), INTENT(IN) :: raw_plist ! Identifier of the raw file ! access property list INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -1797,10 +1805,10 @@ CONTAINS IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: meta_ext + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: meta_ext INTEGER(HID_T), INTENT(IN) :: meta_plist CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: raw_ext - INTEGER(HID_T), INTENT(IN) :: raw_plist + INTEGER(HID_T), INTENT(IN) :: raw_plist INTEGER :: meta_len, raw_len END FUNCTION h5pset_fapl_split_c END INTERFACE @@ -1810,30 +1818,30 @@ CONTAINS hdferr = h5pset_fapl_split_c(prp_id,meta_len,meta_ext,meta_plist,raw_len,raw_ext,raw_plist) END SUBROUTINE h5pset_fapl_split_f -!****s* H5P/h5pget_split_f +!****s* H5P/h5pget_split_f ! NAME -! h5pget_split_f +! h5pget_split_f ! ! PURPOSE ! NOT AVAILABLE ! ! INPUTS -! +! ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! SOURCE ! SUBROUTINE h5pget_split_f(prp_id, meta_ext_size, meta_ext, meta_plist,raw_ext_size,& ! raw_ext, raw_plist, hdferr) @@ -1862,37 +1870,37 @@ CONTAINS ! raw_ext_size, raw_ext, raw_plist ) ! END SUBROUTINE h5pget_split_f -!****s* H5P/h5pset_gc_references_f +!****s* H5P/h5pset_gc_references_f ! NAME -! h5pset_gc_references_f +! h5pset_gc_references_f ! ! PURPOSE -! Sets garbage collecting references flag. +! Sets garbage collecting references flag. ! ! INPUTS -! +! ! prp_id - file access property list identifier -! gc_reference - flag for stting garbage collection on +! gc_reference - flag for stting garbage collection on ! and off (1 or 0) ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! -! Fortran90 Interface: +! port). March 14, 2001 +! +! Fortran90 Interface: SUBROUTINE h5pset_gc_references_f (prp_id, gc_reference, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: gc_reference ! The flag for garbage collecting ! references for the file INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1911,37 +1919,37 @@ CONTAINS hdferr = h5pset_gc_references_c(prp_id, gc_reference) END SUBROUTINE h5pset_gc_references_f -!****s* H5P/h5pget_gc_references_f +!****s* H5P/h5pget_gc_references_f ! NAME -! h5pget_gc_references_f +! h5pget_gc_references_f ! ! PURPOSE -! Returns garbage collecting references setting. +! Returns garbage collecting references setting. ! ! INPUTS -! +! ! prp_id - file access property list identifier ! OUTPUTS -! -! gc_reference - flag for stting garbage collection on +! +! gc_reference - flag for stting garbage collection on ! and off (1 or 0) -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_gc_references_f(prp_id, gc_reference, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: gc_reference ! The flag for garbage collecting ! references for the file INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1956,20 +1964,20 @@ CONTAINS INTEGER, INTENT(OUT) :: gc_reference END FUNCTION h5pget_gc_references_c END INTERFACE - + hdferr = h5pget_gc_references_c(prp_id, gc_reference) END SUBROUTINE h5pget_gc_references_f -!****s* H5P/h5pset_layout_f +!****s* H5P/h5pset_layout_f ! NAME -! h5pset_layout_f +! h5pset_layout_f ! ! PURPOSE -! Sets the type of storage used store the raw data -! for a dataset. +! Sets the type of storage used store the raw data +! for a dataset. ! ! INPUTS -! +! ! prp_id - data creation property list identifier ! layout - type of storage layout for raw data ! possible values are: @@ -1977,24 +1985,24 @@ CONTAINS ! H5D_CONTIGUOUS_F ! H5D_CHUNKED_F ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_layout_f (prp_id, layout, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: layout ! Type of storage layout for raw data ! possible values are: ! H5D_COMPACT_F @@ -2012,44 +2020,44 @@ CONTAINS INTEGER, INTENT(IN) :: layout END FUNCTION h5pset_layout_c END INTERFACE - + hdferr = h5pset_layout_c(prp_id, layout) END SUBROUTINE h5pset_layout_f -!****s* H5P/h5pget_layout_f +!****s* H5P/h5pget_layout_f ! NAME -! h5pget_layout_f +! h5pget_layout_f ! ! PURPOSE -! Returns the layout of the raw data for a dataset. +! Returns the layout of the raw data for a dataset. ! ! INPUTS -! +! ! prp_id - data creation property list identifier ! OUTPUTS -! +! ! layout - type of storage layout for raw data ! possible values are: ! H5D_COMPACT_F ! H5D_CONTIGUOUS_F ! H5D_CHUNKED_F -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_layout_f (prp_id, layout, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: layout ! Type of storage layout for raw data ! possible values are: ! H5D_COMPACT_F(0) @@ -2067,31 +2075,31 @@ CONTAINS INTEGER, INTENT(OUT) :: layout END FUNCTION h5pget_layout_c END INTERFACE - + hdferr = h5pget_layout_c(prp_id, layout) END SUBROUTINE h5pget_layout_f -!****s* H5P/h5pset_filter_f +!****s* H5P/h5pset_filter_f ! NAME -! h5pset_filter_f +! h5pset_filter_f ! ! PURPOSE -! Adds a filter to the filter pipeline. +! Adds a filter to the filter pipeline. ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier -! filter - filter to be added to the pipeline +! filter - filter to be added to the pipeline ! flags - bit vector specifying certain general ! properties of the filter ! cd_nelmts - number of elements in cd_values ! cd_values - auxiliary data for the filter ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -2100,7 +2108,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter ! Filter to be added to the pipeline. INTEGER, INTENT(IN) :: flags ! Bit vector specifying certain general ! properties of the filter. @@ -2114,48 +2122,48 @@ CONTAINS BIND(C,NAME='h5pset_filter_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: filter - INTEGER, INTENT(IN) :: flags - INTEGER(SIZE_T), INTENT(IN) :: cd_nelmts - INTEGER, DIMENSION(*), INTENT(IN) :: cd_values + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, INTENT(IN) :: filter + INTEGER, INTENT(IN) :: flags + INTEGER(SIZE_T), INTENT(IN) :: cd_nelmts + INTEGER, DIMENSION(*), INTENT(IN) :: cd_values END FUNCTION h5pset_filter_c END INTERFACE - + hdferr = h5pset_filter_c(prp_id, filter, flags, cd_nelmts, cd_values ) END SUBROUTINE h5pset_filter_f -!****s* H5P/h5pget_nfilters_f +!****s* H5P/h5pget_nfilters_f ! NAME -! h5pget_nfilters_f +! h5pget_nfilters_f ! ! PURPOSE -! Returns the number of filters in the pipeline. +! Returns the number of filters in the pipeline. ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier ! OUTPUTS -! +! ! nfilters - number of filters in the pipeline -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_nfilters_f (prp_id, nfilters, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: nfilters ! The number of filters in the pipeline INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2169,26 +2177,26 @@ CONTAINS INTEGER, INTENT(OUT) :: nfilters END FUNCTION h5pget_nfilters_c END INTERFACE - + hdferr = h5pget_nfilters_c(prp_id, nfilters) END SUBROUTINE h5pget_nfilters_f -!****s* H5P/h5pget_filter_f +!****s* H5P/h5pget_filter_f ! NAME -! h5pget_filter_f +! h5pget_filter_f ! ! PURPOSE ! Returns information about a filter in a pipeline ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier ! filter_number - sequence number within the filter -! pipeline of the filter for which +! pipeline of the filter for which ! information is sought ! OUTPUTS -! +! ! filter_id - filter identification number ! flags - bit vector specifying certain general ! properties of the filter @@ -2196,25 +2204,25 @@ CONTAINS ! cd_values - auxiliary data for the filter ! namelen - number of characters in the name buffer ! name - buffer to retrieve filter name -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_filter_f(prp_id, filter_number, flags, cd_nelmts, cd_values, namelen, name, filter_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter_number ! Sequence number within the filter - ! pipeline of the filter for which + ! pipeline of the filter for which ! information is sought INTEGER, DIMENSION(*), INTENT(OUT) :: cd_values ! Auxiliary data for the filter. INTEGER, INTENT(OUT) :: flags ! Bit vector specifying certain general @@ -2222,7 +2230,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(INOUT) :: cd_nelmts ! Number of elements in cd_values. INTEGER(SIZE_T), INTENT(IN) :: namelen ! Anticipated number of characters in name. CHARACTER(LEN=*), INTENT(OUT) :: name ! Name of the filter - INTEGER, INTENT(OUT) :: filter_id ! Filter identification number + INTEGER, INTENT(OUT) :: filter_id ! Filter identification number INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -2239,60 +2247,60 @@ CONTAINS IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: filter_number + INTEGER, INTENT(IN) :: filter_number INTEGER, DIMENSION(*), INTENT(OUT) :: cd_values - INTEGER, INTENT(OUT) :: flags + INTEGER, INTENT(OUT) :: flags INTEGER(SIZE_T), INTENT(INOUT) :: cd_nelmts INTEGER(SIZE_T), INTENT(IN) :: namelen CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name INTEGER, INTENT(OUT) :: filter_id END FUNCTION h5pget_filter_c END INTERFACE - - hdferr = h5pget_filter_c(prp_id, filter_number, flags, cd_nelmts, & + + hdferr = h5pget_filter_c(prp_id, filter_number, flags, cd_nelmts, & cd_values, namelen, name, filter_id ) END SUBROUTINE h5pget_filter_f -!****s* H5P/h5pset_external_f +!****s* H5P/h5pset_external_f ! NAME -! h5pset_external_f +! h5pset_external_f ! ! PURPOSE -! Adds an external file to the list of external files. +! Adds an external file to the list of external files. ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! name - name of external file -! offset - offset in bytes from the beginning of the +! offset - offset in bytes from the beginning of the ! file to the location in the file ! where the data starts -! bytes - size of the external file data. +! bytes - size of the external file data. ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 14, 2001 ! ! Changed type of 'offset' from integer to off_t -- MSB January 9, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5pset_external_f(prp_id, name, offset, bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of an external file - INTEGER(OFF_T), INTENT(IN) :: offset ! Offset, in bytes, from the beginning - ! of the file to the location in the file + INTEGER(OFF_T), INTENT(IN) :: offset ! Offset, in bytes, from the beginning + ! of the file to the location in the file ! where the data starts. - INTEGER(HSIZE_T), INTENT(IN) :: bytes ! Number of bytes reserved in the + INTEGER(HSIZE_T), INTENT(IN) :: bytes ! Number of bytes reserved in the ! file for the data INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2312,43 +2320,43 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: bytes END FUNCTION h5pset_external_c END INTERFACE - + namelen = LEN(name) hdferr = h5pset_external_c(prp_id, name, namelen, offset, bytes) END SUBROUTINE h5pset_external_f -!****s* H5P/h5pget_external_count_f +!****s* H5P/h5pget_external_count_f ! NAME -! h5pget_external_count_f +! h5pget_external_count_f ! ! PURPOSE -! Returns the number of external files for a dataset. +! Returns the number of external files for a dataset. ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! OUTPUTS -! -! count - number of external files for the +! +! count - number of external files for the ! specified dataset -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_external_count_f (prp_id, count, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER, INTENT(OUT) :: count ! Number of external files for the + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: count ! Number of external files for the ! Specified dataset INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2358,60 +2366,60 @@ CONTAINS BIND(C,NAME='h5pget_external_count_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER, INTENT(OUT) :: count END FUNCTION h5pget_external_count_c END INTERFACE - + hdferr = h5pget_external_count_c(prp_id, count) END SUBROUTINE h5pget_external_count_f -!****s* H5P/h5pget_external_f +!****s* H5P/h5pget_external_f ! NAME -! h5pget_external_f +! h5pget_external_f ! ! PURPOSE -! Returns information about an external file. +! Returns information about an external file. ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! OUTPUTS -! -! idx - external file index +! +! idx - external file index ! name_size - maximum size of name array -! name - name of the external file +! name - name of the external file ! name - name of external file -! offset - offset in bytes from the beginning of the +! offset - offset in bytes from the beginning of the ! file to the location in the file ! where the data starts ! bytes - size of the external file data -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). March 14, 2001 ! ! Changed type of 'offset' from integer to off_t -- MSB January 9, 2012 -! +! ! Fortran90 Interface: SUBROUTINE h5pget_external_f(prp_id, idx, name_size, name, offset,bytes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: idx ! External file index. - INTEGER(SIZE_T), INTENT(IN) :: name_size ! Maximum length of name array + INTEGER(SIZE_T), INTENT(IN) :: name_size ! Maximum length of name array CHARACTER(LEN=*), INTENT(OUT) :: name ! Name of an external file - INTEGER(OFF_T), INTENT(OUT) :: offset ! Offset, in bytes, from the beginning - ! of the file to the location in the file + INTEGER(OFF_T), INTENT(OUT) :: offset ! Offset, in bytes, from the beginning + ! of the file to the location in the file ! where the data starts. - INTEGER(HSIZE_T), INTENT(OUT) :: bytes ! Number of bytes reserved in the + INTEGER(HSIZE_T), INTENT(OUT) :: bytes ! Number of bytes reserved in the ! file for the data INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2423,54 +2431,54 @@ CONTAINS IMPORT :: HID_T, SIZE_T, HSIZE_T, OFF_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: idx + INTEGER, INTENT(IN) :: idx INTEGER(SIZE_T), INTENT(IN) :: name_size CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name INTEGER(OFF_T), INTENT(OUT) :: offset INTEGER(HSIZE_T), INTENT(OUT) :: bytes END FUNCTION h5pget_external_c END INTERFACE - + hdferr = h5pget_external_c(prp_id, idx, name_size, name, offset, bytes) END SUBROUTINE h5pget_external_f -!****s* H5P/h5pset_btree_ratios_f +!****s* H5P/h5pset_btree_ratios_f ! NAME -! h5pset_btree_ratios_f +! h5pset_btree_ratios_f ! ! PURPOSE -! Sets B-tree split ratios for a dataset transfer -! property list. +! Sets B-tree split ratios for a dataset transfer +! property list. ! ! INPUTS -! -! prp_id - the dataset transfer property list -! identifier -! left - the B-tree split ratio for left-most nodes +! +! prp_id - the dataset transfer property list +! identifier +! left - the B-tree split ratio for left-most nodes ! middle - the B-tree split ratio for all other nodes ! right - the B-tree split ratio for right-most nodes ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pset_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier REAL, INTENT(IN) :: left ! The B-tree split ratio for left-most nodes. - REAL, INTENT(IN) :: middle ! The B-tree split ratio for all other nodes - REAL, INTENT(IN) :: right ! The B-tree split ratio for right-most - ! nodes and lone nodes. + REAL, INTENT(IN) :: middle ! The B-tree split ratio for all other nodes + REAL, INTENT(IN) :: right ! The B-tree split ratio for right-most + ! nodes and lone nodes. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -2485,7 +2493,7 @@ CONTAINS REAL, INTENT(IN) :: right END FUNCTION h5pset_btree_ratios_c END INTERFACE - + hdferr = h5pset_btree_ratios_c(prp_id, left, middle, right) END SUBROUTINE h5pset_btree_ratios_f @@ -2497,34 +2505,34 @@ CONTAINS ! Gets B-tree split ratios for a dataset transfer property list ! ! INPUTS -! -! prp_id - the dataset transfer property list -! identifier +! +! prp_id - the dataset transfer property list +! identifier ! OUTPUTS -! -! left - the B-tree split ratio for left-most nodes +! +! left - the B-tree split ratio for left-most nodes ! middle - the B-tree split ratio for all other nodes ! right - the B-tree split ratio for right-most nodes -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! August 12, 1999 +! August 12, 1999 ! ! HISTORY -! Explicit Fortran interfaces were added for +! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 14, 2001 -! +! port). March 14, 2001 +! ! Fortran90 Interface: SUBROUTINE h5pget_btree_ratios_f(prp_id, left, middle, right, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier REAL, INTENT(OUT) :: left ! The B-tree split ratio for left-most nodes. - REAL, INTENT(OUT) :: middle ! The B-tree split ratio for all other nodes - REAL, INTENT(OUT) :: right ! The B-tree split ratio for right-most + REAL, INTENT(OUT) :: middle ! The B-tree split ratio for all other nodes + REAL, INTENT(OUT) :: right ! The B-tree split ratio for right-most ! nodes and lone nodes. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2540,43 +2548,43 @@ CONTAINS REAL, INTENT(OUT) :: right END FUNCTION h5pget_btree_ratios_c END INTERFACE - + hdferr = h5pget_btree_ratios_c(prp_id, left, middle, right) END SUBROUTINE h5pget_btree_ratios_f -!****s* H5P/h5pget_fclose_degree_f +!****s* H5P/h5pget_fclose_degree_f ! NAME -! h5pget_fclose_degree_f +! h5pget_fclose_degree_f ! ! PURPOSE ! Returns the degree for the file close behavior. ! ! INPUTS -! +! ! fapl_id - File access property list identifier ! OUTPUTS -! +! ! degree - Possible values are: ! H5F_CLOSE_DEFAULT_F ! H5F_CLOSE_WEAK_F ! H5F_CLOSE_SEMI_F ! H5F_CLOSE_STRONG_F -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! September 26, 2002 +! September 26, 2002 ! ! HISTORY -! -! +! +! ! Fortran90 Interface: SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier - INTEGER, INTENT(OUT) :: degree ! Possible values are: + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier + INTEGER, INTENT(OUT) :: degree ! Possible values are: ! H5F_CLOSE_DEFAULT_F ! H5F_CLOSE_WEAK_F ! H5F_CLOSE_SEMI_F @@ -2593,19 +2601,19 @@ CONTAINS INTEGER, INTENT(OUT) :: degree END FUNCTION h5pget_fclose_degree_c END INTERFACE - - hdferr = h5pget_fclose_degree_c(fapl_id, degree) + + hdferr = h5pget_fclose_degree_c(fapl_id, degree) END SUBROUTINE h5pget_fclose_degree_f -!****s* H5P/h5pset_fclose_degree_f +!****s* H5P/h5pset_fclose_degree_f ! NAME -! h5pset_fclose_degree_f +! h5pset_fclose_degree_f ! ! PURPOSE ! Sets the degree for the file close behavior. ! ! INPUTS -! +! ! fapl_id - file access property list identifier ! degree - Possible values are: ! H5F_CLOSE_DEFAULT_F @@ -2613,19 +2621,19 @@ CONTAINS ! H5F_CLOSE_SEMI_F ! H5F_CLOSE_STRONG_F ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! September 26, 2002 +! September 26, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier - INTEGER, INTENT(IN) :: degree ! Possible values are: + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier + INTEGER, INTENT(IN) :: degree ! Possible values are: ! H5F_CLOSE_DEFAULT_F ! H5F_CLOSE_WEAK_F ! H5F_CLOSE_SEMI_F @@ -2643,43 +2651,43 @@ CONTAINS END FUNCTION h5pset_fclose_degree_c END INTERFACE - hdferr = h5pset_fclose_degree_c(fapl_id, degree) + hdferr = h5pset_fclose_degree_c(fapl_id, degree) END SUBROUTINE h5pset_fclose_degree_f -!****s* H5P/h5pequal_f +!****s* H5P/h5pequal_f ! NAME -! h5pequal_f +! h5pequal_f ! ! PURPOSE ! Checks if two property lists are eqaul ! ! INPUTS -! +! ! plist1_id - property list identifier ! plist2_id - property list identifier ! OUTPUTS -! +! ! flag - flag, possible values ! .TRUE. or .FALSE. -! hdferr: - error code +! hdferr: - error code ! Success: 0 -! Failure: -1, flag is set to .FALSE. +! Failure: -1, flag is set to .FALSE. ! ! AUTHOR ! Elena Pourmal -! September 30, 2002 +! September 30, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier - INTEGER(HID_T), INTENT(IN) :: plist2_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: plist2_id ! Property list identifier LOGICAL, INTENT(OUT) :: flag ! Flag INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTEGER :: c_flag - + INTERFACE INTEGER FUNCTION h5pequal_c(plist1_id, plist2_id, c_flag) & BIND(C,NAME='h5pequal_c') @@ -2692,36 +2700,36 @@ CONTAINS END INTERFACE flag = .FALSE. - hdferr = h5pequal_c(plist1_id, plist2_id, c_flag) + hdferr = h5pequal_c(plist1_id, plist2_id, c_flag) IF (c_flag .GT. 0) flag = .TRUE. END SUBROUTINE h5pequal_f !****s* H5P/h5pset_buffer_f ! NAME -! h5pset_buffer_f +! h5pset_buffer_f ! ! PURPOSE ! Sets sixe for conversion buffer ! ! INPUTS ! plist_id - data transfer property list identifier -! size - buffer size +! size - buffer size ! OUTPUTS -! -! hdferr: - error code +! +! hdferr: - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 2, 2002 +! October 2, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_buffer_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier - INTEGER(HSIZE_T), INTENT(IN) :: size ! Buffer size in bytes; - ! buffer is allocated and freed by + INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: size ! Buffer size in bytes; + ! buffer is allocated and freed by ! the library. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2737,36 +2745,36 @@ CONTAINS END FUNCTION h5pset_buffer_c END INTERFACE - hdferr = h5pset_buffer_c(plist_id, size) + hdferr = h5pset_buffer_c(plist_id, size) END SUBROUTINE h5pset_buffer_f !****s* H5P/h5pget_buffer_f ! NAME -! h5pget_buffer_f +! h5pget_buffer_f ! ! PURPOSE ! Gets size for conversion buffer ! ! INPUTS -! +! ! plist_id - data transfer property list identifier ! OUTPUTS -! -! size - buffer size -! hdferr - error code +! +! size - buffer size +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 2, 2002 +! October 2, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_buffer_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier - INTEGER(HSIZE_T), INTENT(OUT) :: size ! Buffer size in bytes; - ! buffer is allocated and freed by + INTEGER(HID_T), INTENT(IN) :: plist_id ! Data transfer property list identifier + INTEGER(HSIZE_T), INTENT(OUT) :: size ! Buffer size in bytes; + ! buffer is allocated and freed by ! the library. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -2782,7 +2790,7 @@ CONTAINS END FUNCTION h5pget_buffer_c END INTERFACE - hdferr = h5pget_buffer_c(plist_id, size) + hdferr = h5pget_buffer_c(plist_id, size) END SUBROUTINE h5pget_buffer_f !****s* H5P/h5pfill_value_defined_f @@ -2793,17 +2801,17 @@ CONTAINS ! Check if fill value is defined. ! ! INPUTS -! +! ! plist_id - dataset creation property list identifier ! OUTPUTS -! +! ! flag - fill value status flag ! Possible values are: ! H5D_FILL_VALUE_ERROR_F ! H5D_FILL_VALUE_UNDEFINED_F ! H5D_FILL_VALUE_DEFAULT_F ! H5D_FILL_VALUE_USER_DEFINED_F -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! @@ -2833,7 +2841,7 @@ CONTAINS END FUNCTION h5pfill_value_defined_c END INTERFACE - hdferr = h5pfill_value_defined_c(plist_id, flag) + hdferr = h5pfill_value_defined_c(plist_id, flag) END SUBROUTINE h5pfill_value_defined_f !****s* H5P/h5pset_alloc_time_f @@ -2844,7 +2852,7 @@ CONTAINS ! Set space allocation time for dataset during creation. ! ! INPUTS -! +! ! plist_id - dataset creation property list identifier ! flag - allocation time flag: ! H5D_ALLOC_TIME_ERROR_F @@ -2853,14 +2861,14 @@ CONTAINS ! H5D_ALLOC_TIME_LATE_F ! H5D_ALLOC_TIME_INCR_F ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 4, 2002 +! October 4, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_alloc_time_f(plist_id, flag, hdferr) @@ -2874,8 +2882,8 @@ CONTAINS ! H5D_ALLOC_TIME_INCR_F INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** - +!***** + INTERFACE INTEGER FUNCTION h5pset_alloc_time_c(plist_id, flag) & BIND(C,NAME='h5pset_alloc_time_c') @@ -2885,8 +2893,8 @@ CONTAINS INTEGER, INTENT(IN) :: flag END FUNCTION h5pset_alloc_time_c END INTERFACE - - hdferr = h5pset_alloc_time_c(plist_id, flag) + + hdferr = h5pset_alloc_time_c(plist_id, flag) END SUBROUTINE h5pset_alloc_time_f !****s* H5P/h5pget_alloc_time_f @@ -2897,23 +2905,23 @@ CONTAINS ! Get space allocation time for dataset during creation. ! ! INPUTS -! +! ! plist_id - dataset creation property list identifier ! OUTPUTS -! +! ! flag - allocation time flag: ! H5D_ALLOC_TIME_ERROR_F ! H5D_ALLOC_TIME_DEFAULT_F ! H5D_ALLOC_TIME_EARLY_F ! H5D_ALLOC_TIME_LATE_F ! H5D_ALLOC_TIME_INCR_F -! hdferr: - error code +! hdferr: - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 4, 2002 +! October 4, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_alloc_time_f(plist_id, flag, hdferr) @@ -2938,8 +2946,8 @@ CONTAINS INTEGER, INTENT(OUT) :: flag END FUNCTION h5pget_alloc_time_c END INTERFACE - - hdferr = h5pget_alloc_time_c(plist_id, flag) + + hdferr = h5pget_alloc_time_c(plist_id, flag) END SUBROUTINE h5pget_alloc_time_f !****s* H5P/h5pset_fill_time_f @@ -2950,21 +2958,21 @@ CONTAINS ! Set fill value writing time for dataset ! ! INPUTS -! +! ! plist_id - dataset creation property list identifier ! flag - fill time flag: ! H5D_FILL_TIME_ERROR_F ! H5D_FILL_TIME_ALLOC_F ! H5D_FILL_TIME_NEVER_F ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 4, 2002 +! October 4, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_fill_time_f(plist_id, flag, hdferr) @@ -2976,7 +2984,7 @@ CONTAINS ! H5D_FILL_TIME_NEVER_F INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pset_fill_time_c(plist_id, flag) & @@ -2987,8 +2995,8 @@ CONTAINS INTEGER, INTENT(IN) :: flag END FUNCTION h5pset_fill_time_c END INTERFACE - - hdferr = h5pset_fill_time_c(plist_id, flag) + + hdferr = h5pset_fill_time_c(plist_id, flag) END SUBROUTINE h5pset_fill_time_f !****s* H5P/h5pget_fill_time_f @@ -2999,11 +3007,11 @@ CONTAINS ! Get fill value writing time for dataset ! ! INPUTS -! +! ! plist_id - dataset creation property list identifier ! OUTPUTS -! -! hdferr: - error code +! +! hdferr: - error code ! Success: 0 ! Failure: -1 ! OPTIONAL PARAMETERS @@ -3014,7 +3022,7 @@ CONTAINS ! H5D_FILL_TIME_NEVER_F ! AUTHOR ! Elena Pourmal -! October 4, 2002 +! October 4, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_fill_time_f(plist_id, flag, hdferr) @@ -3026,8 +3034,8 @@ CONTAINS ! H5D_FILL_TIME_NEVER_F INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** - +!***** + INTERFACE INTEGER FUNCTION h5pget_fill_time_c(plist_id, flag) & BIND(C,NAME='h5pget_fill_time_c') @@ -3037,36 +3045,36 @@ CONTAINS INTEGER, INTENT(OUT) :: flag END FUNCTION h5pget_fill_time_c END INTERFACE - - hdferr = h5pget_fill_time_c(plist_id, flag) + + hdferr = h5pget_fill_time_c(plist_id, flag) END SUBROUTINE h5pget_fill_time_f -!****s* H5P/ h5pset_meta_block_size_f +!****s* H5P/ h5pset_meta_block_size_f ! NAME -! h5pset_meta_block_size_f +! h5pset_meta_block_size_f ! ! PURPOSE -! Sets the minimum size of metadata block allocations +! Sets the minimum size of metadata block allocations ! ! INPUTS -! +! ! plist_id - file access property list identifier ! size - metatdata block size ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier - INTEGER(HSIZE_T), INTENT(IN) :: size ! Block size in bytes; + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: size ! Block size in bytes; INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -3079,78 +3087,78 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: size END FUNCTION h5pset_meta_block_size_c END INTERFACE - - hdferr = h5pset_meta_block_size_c(plist_id, size) + + hdferr = h5pset_meta_block_size_c(plist_id, size) END SUBROUTINE h5pset_meta_block_size_f -!****s* H5P/h5pget_meta_block_size_f +!****s* H5P/h5pget_meta_block_size_f ! NAME -! h5pget_meta_block_size_f +! h5pget_meta_block_size_f ! ! PURPOSE -! Gets the minimum size of metadata block allocations +! Gets the minimum size of metadata block allocations ! ! INPUTS -! +! ! plist_id - file access property list identifier ! OUTPUTS -! +! ! size - metatdata block size -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_meta_block_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier - INTEGER(HSIZE_T), INTENT(OUT) :: size ! Block size in bytes; + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(HSIZE_T), INTENT(OUT) :: size ! Block size in bytes; INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTERFACE INTEGER FUNCTION h5pget_meta_block_size_c(plist_id, size) & BIND(C,NAME='h5pget_meta_block_size_c') - IMPORT :: HID_T, HSIZE_T + IMPORT :: HID_T, HSIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id INTEGER(HSIZE_T), INTENT(OUT) :: size END FUNCTION h5pget_meta_block_size_c END INTERFACE - - hdferr = h5pget_meta_block_size_c(plist_id, size) + + hdferr = h5pget_meta_block_size_c(plist_id, size) END SUBROUTINE h5pget_meta_block_size_f -!****s* H5P/h5pset_sieve_buf_size_f +!****s* H5P/h5pset_sieve_buf_size_f ! NAME -! h5pset_sieve_buf_size_f +! h5pset_sieve_buf_size_f ! ! PURPOSE ! Sets the maximum size of the data sieve buffer ! ! INPUTS -! +! ! plist_id - file access property list identifier ! size - sieve buffer size ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier - INTEGER(SIZE_T), INTENT(IN) :: size ! Buffer size in bytes; + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(IN) :: size ! Buffer size in bytes; INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -3163,36 +3171,36 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: size END FUNCTION h5pset_sieve_buf_size_c END INTERFACE - - hdferr = h5pset_sieve_buf_size_c(plist_id, size) + + hdferr = h5pset_sieve_buf_size_c(plist_id, size) END SUBROUTINE h5pset_sieve_buf_size_f !****s* H5P/h5pget_sieve_buf_size_f ! NAME -! h5pget_sieve_buf_size_f +! h5pget_sieve_buf_size_f ! ! PURPOSE ! Gets the maximum size of the data sieve buffer ! ! INPUTS -! +! ! plist_id - file access property list identifier ! OUTPUTS -! +! ! size - sieve buffer size -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_sieve_buf_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier - INTEGER(SIZE_T), INTENT(OUT) :: size ! Buffer size in bytes + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(OUT) :: size ! Buffer size in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -3205,35 +3213,35 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: size END FUNCTION h5pget_sieve_buf_size_c END INTERFACE - - hdferr = h5pget_sieve_buf_size_c(plist_id, size) + + hdferr = h5pget_sieve_buf_size_c(plist_id, size) END SUBROUTINE h5pget_sieve_buf_size_f -!****s* H5P/h5pset_small_data_block_size_f +!****s* H5P/h5pset_small_data_block_size_f ! NAME -! h5pset_small_data_block_size_f +! h5pset_small_data_block_size_f ! ! PURPOSE ! Sets the minimum size of "small" raw data block ! ! INPUTS -! +! ! plist_id - file access property list identifier ! size - small raw data block size ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(IN) :: size ! Small raw data block size INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3248,34 +3256,34 @@ CONTAINS END FUNCTION h5pset_small_data_block_size_c END INTERFACE - hdferr = h5pset_small_data_block_size_c(plist_id, size) + hdferr = h5pset_small_data_block_size_c(plist_id, size) END SUBROUTINE h5pset_small_data_block_size_f -!****s* H5P/h5pget_small_data_block_size_f +!****s* H5P/h5pget_small_data_block_size_f ! NAME -! h5pget_small_data_block_size_f +! h5pget_small_data_block_size_f ! ! PURPOSE ! Gets the minimum size of "small" raw data block ! ! INPUTS -! +! ! plist_id - file access property list identifier ! OUTPUTS -! +! ! size - small raw data block size -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_small_data_block_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! File access property list identifier INTEGER(HSIZE_T), INTENT(OUT) :: size ! Small raw data block size INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3289,35 +3297,35 @@ CONTAINS INTEGER(HSIZE_T), INTENT(OUT) :: size END FUNCTION h5pget_small_data_block_size_c END INTERFACE - - hdferr = h5pget_small_data_block_size_c(plist_id, size) + + hdferr = h5pget_small_data_block_size_c(plist_id, size) END SUBROUTINE h5pget_small_data_block_size_f -!****s* H5P/h5pset_hyper_vector_size_f +!****s* H5P/h5pset_hyper_vector_size_f ! NAME -! h5pset_hyper_vector_size_f +! h5pset_hyper_vector_size_f ! ! PURPOSE ! Set the number of "I/O" vectors (vector size) ! ! INPUTS -! +! ! plist_id - dataset transfer property list identifier ! size - vector size ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pset_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier INTEGER(SIZE_T), INTENT(IN) :: size ! Vector size INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3331,35 +3339,35 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: size END FUNCTION h5pset_hyper_vector_size_c END INTERFACE - - hdferr = h5pset_hyper_vector_size_c(plist_id, size) + + hdferr = h5pset_hyper_vector_size_c(plist_id, size) END SUBROUTINE h5pset_hyper_vector_size_f -!****s* H5P/ h5pget_hyper_vector_size_f +!****s* H5P/ h5pget_hyper_vector_size_f ! NAME -! h5pget_hyper_vector_size_f +! h5pget_hyper_vector_size_f ! ! PURPOSE ! Get the number of "I/O" vectors (vector size) ! ! INPUTS -! +! ! plist_id - dataset transfer property list identifier ! OUTPUTS -! +! ! size - vector size -! hdferr - error code +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 7, 2002 +! October 7, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_hyper_vector_size_f(plist_id, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset transfer property list identifier INTEGER(SIZE_T), INTENT(OUT) :: size ! Vector size INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3374,42 +3382,42 @@ CONTAINS END FUNCTION h5pget_hyper_vector_size_c END INTERFACE - hdferr = h5pget_hyper_vector_size_c(plist_id, size) + hdferr = h5pget_hyper_vector_size_c(plist_id, size) END SUBROUTINE h5pget_hyper_vector_size_f -!****s* H5P/h5pexist_f +!****s* H5P/h5pexist_f ! NAME -! h5pexist_f +! h5pexist_f ! ! PURPOSE -! Queries whether a property name exists in a property list or class. +! Queries whether a property name exists in a property list or class. ! ! INPUTS -! +! ! prp_id - property list identifier to query ! name - name of property to check for ! OUTPUTS -! +! ! flag - logical flag -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pexist_f(prp_id, name, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to modify LOGICAL, INTENT(OUT) :: flag ! .TRUE. if exists, .FALSE. otherwise INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTEGER :: name_len - + INTERFACE INTEGER FUNCTION h5pexist_c(prp_id, name, name_len) & BIND(C,NAME='h5pexist_c') @@ -3430,43 +3438,43 @@ CONTAINS ENDIF END SUBROUTINE h5pexist_f -!****s* H5P/h5pget_size_f +!****s* H5P/h5pget_size_f ! ! NAME -! h5pget_size_f +! h5pget_size_f ! ! PURPOSE ! Queries the size of a property value in bytes. ! ! INPUTS -! +! ! prp_id - property list identifier to query ! name - name of property to query ! OUTPUTS -! +! ! size - size of property in bytes -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! HISTORY -! -! +! +! ! Fortran90 Interface: SUBROUTINE h5pget_size_f(prp_id, name, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of property to query INTEGER(SIZE_T), INTENT(OUT) :: size ! Size in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTEGER :: name_len - + INTERFACE INTEGER FUNCTION h5pget_size_c(prp_id, name, name_len, size) & BIND(C,NAME='h5pget_size_c') @@ -3483,31 +3491,31 @@ CONTAINS hdferr = h5pget_size_c(prp_id, name , name_len, size) END SUBROUTINE h5pget_size_f -!****s* H5P/h5pget_npros_f +!****s* H5P/h5pget_npros_f ! NAME -! h5pget_npros_f +! h5pget_npros_f ! ! PURPOSE ! Queries number of properties in property list or class ! ! INPUTS -! +! ! prp_id - iproperty list identifier to query ! OUTPUTS -! +! ! nprops - number of properties in property object -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_nprops_f(prp_id, nprops, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(SIZE_T), INTENT(OUT) :: nprops ! Number of properties INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3524,18 +3532,18 @@ CONTAINS hdferr = h5pget_nprops_c(prp_id, nprops) END SUBROUTINE h5pget_nprops_f -!****s* H5P/h5pget_class_name_f +!****s* H5P/h5pget_class_name_f ! NAME -! h5pget_class_name_f +! h5pget_class_name_f ! ! PURPOSE ! Queries the name of a class. ! ! INPUTS -! +! ! prp_id - property list identifier to query ! OUTPUTS -! +! ! name - name of a class ! size - Actual length of the class name ! NOTE: If provided buffer "name" is smaller, @@ -3543,26 +3551,26 @@ CONTAINS ! provided user buffer. ! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! HISTORY -! Returned the size of name as an argument -! +! Returned the size of name as an argument +! ! Fortran90 Interface: SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier CHARACTER(LEN=*), INTENT(OUT) :: name ! Buffer to retireve class name INTEGER, INTENT(OUT) :: size ! Actual length of the class name INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTEGER :: name_len - + INTERFACE INTEGER FUNCTION h5pget_class_name_c(prp_id, name, name_len) & BIND(C,NAME='h5pget_class_name_c') @@ -3574,42 +3582,42 @@ CONTAINS INTEGER, INTENT(IN) :: name_len END FUNCTION h5pget_class_name_c END INTERFACE - + name_len = LEN(name) size = h5pget_class_name_c(prp_id, name, name_len) - + hdferr = 0 IF(size.LT.0) hdferr = -1 - + END SUBROUTINE h5pget_class_name_f -!****s* H5P/h5pget_class_parent_f +!****s* H5P/h5pget_class_parent_f ! NAME -! h5pget_class_parent_f +! h5pget_class_parent_f ! ! PURPOSE -! Retrieves the parent class of a genric property class. +! Retrieves the parent class of a genric property class. ! ! INPUTS -! +! ! prp_id - property list identifier to query ! OUTPUTS -! +! ! parent_id - identifier of the parent class -! hdferr: - error code +! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pget_class_parent_f(prp_id, parent_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(HID_T), INTENT(OUT) :: parent_id ! Parent class property list - ! identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(OUT) :: parent_id ! Parent class property list + ! identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -3625,32 +3633,32 @@ CONTAINS hdferr = h5pget_class_parent_c(prp_id, parent_id) END SUBROUTINE h5pget_class_parent_f -!****s* H5P/h5pisa_class_f +!****s* H5P/h5pisa_class_f ! NAME -! h5pisa_class_f +! h5pisa_class_f ! ! PURPOSE -! Determines whether a property list is a member of a class. +! Determines whether a property list is a member of a class. ! ! INPUTS -! -! plist - property list identifier +! +! plist - property list identifier ! pclass - identifier of the property class ! OUTPUTS -! +! ! flag - .TRUE. if a member, .FALSE. otherwise -! hdferr: - error code +! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pisa_class_f(plist, pclass, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: plist ! Property list identifier INTEGER(HID_T), INTENT(IN) :: pclass ! Class identifier LOGICAL, INTENT(OUT) :: flag ! logical flag INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -3673,40 +3681,40 @@ CONTAINS ENDIF END SUBROUTINE h5pisa_class_f -!****s* H5P/h5pcopy_prop_f +!****s* H5P/h5pcopy_prop_f ! NAME -! h5pcopy_prop_f +! h5pcopy_prop_f ! ! PURPOSE ! Copies a property from one list or class to another. ! ! INPUTS -! +! ! dst_id - Identifier of the destination property list -! src_id - Identifier of the source property list +! src_id - Identifier of the source property list ! name - name of the property to copy ! OUTPUTS -! +! ! hdferr: - error code -! Success: 0 -! Failure: -1 +! Success: 0 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pcopy_prop_f(dst_id, src_id, name, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dst_id ! Destination property list - ! identifier - INTEGER(HID_T), INTENT(IN) :: src_id ! Source property list identifier + INTEGER(HID_T), INTENT(IN) :: dst_id ! Destination property list + ! identifier + INTEGER(HID_T), INTENT(IN) :: src_id ! Source property list identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Property name INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** INTEGER :: name_len - + INTERFACE INTEGER FUNCTION h5pcopy_prop_c(dst_id, src_id, name, name_len) & BIND(C,NAME='h5pcopy_prop_c') @@ -3723,27 +3731,27 @@ CONTAINS hdferr = h5pcopy_prop_c(dst_id, src_id, name , name_len) END SUBROUTINE h5pcopy_prop_f -!****s* H5P/h5premove_f +!****s* H5P/h5premove_f ! NAME -! h5premove_f +! h5premove_f ! ! PURPOSE -! Removes a property from a property list. +! Removes a property from a property list. ! ! INPUTS -! +! ! plid - Property list identofoer ! name - name of the property to remove ! OUTPUTS -! +! ! hdferr: - error code -! Success: 0 -! Failure: -1 +! Success: 0 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5premove_f(plid, name, hdferr) @@ -3754,14 +3762,14 @@ CONTAINS ! 0 on success and -1 on failure !***** INTEGER :: name_len - + INTERFACE INTEGER FUNCTION h5premove_c(plid, name, name_len) & BIND(C,NAME='h5premove_c') IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plid + INTEGER(HID_T), INTENT(IN) :: plid CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name INTEGER, INTENT(IN) :: name_len END FUNCTION h5premove_c @@ -3770,26 +3778,26 @@ CONTAINS hdferr = h5premove_c(plid, name , name_len) END SUBROUTINE h5premove_f -!****s* H5P/h5punregister_f +!****s* H5P/h5punregister_f ! NAME -! h5punregister_f +! h5punregister_f ! ! PURPOSE -! Removes a property from a property list class. +! Removes a property from a property list class. ! ! INPUTS -! +! ! class - Property list class identifier ! name - name of the property to remove ! OUTPUTS -! +! ! hdferr: - error code -! Success: 0 -! Failure: -1 +! Success: 0 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5punregister_f(class, name, hdferr) @@ -3816,25 +3824,25 @@ CONTAINS hdferr = h5punregister_c(class, name , name_len) END SUBROUTINE h5punregister_f -!****s* H5P/h5pclose_class_f +!****s* H5P/h5pclose_class_f ! NAME -! h5pclose_class_f +! h5pclose_class_f ! ! PURPOSE ! Closes an existing property list class. ! ! INPUTS -! +! ! class - Property list class identifier ! OUTPUTS -! -! hdferr - error code -! Success: 0 -! Failure: -1 +! +! hdferr - error code +! Success: 0 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal -! October 9, 2002 +! October 9, 2002 ! ! Fortran90 Interface: SUBROUTINE h5pclose_class_f(class, hdferr) @@ -3854,9 +3862,9 @@ CONTAINS hdferr = h5pclose_class_c(class) END SUBROUTINE h5pclose_class_f -!****s* H5P/h5pset_shuffle_f +!****s* H5P/h5pset_shuffle_f ! NAME -! h5pset_shuffle_f +! h5pset_shuffle_f ! ! PURPOSE ! Sets shuffling filter @@ -3864,9 +3872,9 @@ CONTAINS ! INPUTS ! prp_id - dataset creation property list identifier ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -3875,7 +3883,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_shuffle_f(prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -3888,26 +3896,26 @@ CONTAINS END FUNCTION h5pset_shuffle_c END INTERFACE hdferr = h5pset_shuffle_c(prp_id) - + END SUBROUTINE h5pset_shuffle_f -!****s* H5P/h5pset_edc_check_f +!****s* H5P/h5pset_edc_check_f ! NAME -! h5pset_edc_check_f +! h5pset_edc_check_f ! ! PURPOSE -! Enables/disables error detecting +! Enables/disables error detecting ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! flag - EDC flag; possible values: ! H5Z_DISABLE_EDC_F ! H5Z_ENABLE_EDC_F ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -3916,7 +3924,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: flag ! Checksum filter flag INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -3927,27 +3935,27 @@ CONTAINS IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: flag + INTEGER, INTENT(IN) :: flag END FUNCTION h5pset_edc_check_c END INTERFACE hdferr = h5pset_edc_check_c(prp_id, flag) - + END SUBROUTINE h5pset_edc_check_f !****s* H5P/h5pget_edc_check_f ! NAME -! h5pget_edc_check_f +! h5pget_edc_check_f ! ! PURPOSE -! Queries error detecting +! Queries error detecting ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -3956,7 +3964,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pget_edc_check_f(prp_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset transfer property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset transfer property list identifier INTEGER, INTENT(OUT) :: flag ! Checksum filter flag ! May have one of the following values: ! H5Z_ERROR_EDC_F @@ -3976,24 +3984,24 @@ CONTAINS END FUNCTION h5pget_edc_check_c END INTERFACE hdferr = h5pget_edc_check_c(prp_id, flag) - + END SUBROUTINE h5pget_edc_check_f !****s* H5P/h5pset_fletcher32_f ! NAME -! h5pset_fletcher32_f +! h5pset_fletcher32_f ! ! PURPOSE -! Sets Fletcher32 checksum of EDC for a dataset creation +! Sets Fletcher32 checksum of EDC for a dataset creation ! property list. ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4002,7 +4010,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_fletcher32_f(prp_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure !***** @@ -4020,19 +4028,19 @@ CONTAINS !****s* H5P/ h5pset_family_offset_f ! NAME -! h5pset_family_offset_f +! h5pset_family_offset_f ! ! PURPOSE ! Sets offset for family file driver. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! offset - file offset ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4041,42 +4049,42 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_family_offset_f(prp_id, offset, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER(HSIZE_T), INTENT(IN) :: offset ! Offset in bytes INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pset_family_offset_c(prp_id, offset) & BIND(C,NAME='h5pset_family_offset_c') IMPORT :: HID_T, HSIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER(HSIZE_T), INTENT(IN) :: offset + INTEGER(HSIZE_T), INTENT(IN) :: offset END FUNCTION h5pset_family_offset_c END INTERFACE hdferr = h5pset_family_offset_c(prp_id, offset) - + END SUBROUTINE h5pset_family_offset_f !****s* H5P/h5pset_fapl_multi_l ! NAME -! h5pset_fapl_multi_l +! h5pset_fapl_multi_l ! ! PURPOSE -! Sets up use of the multi-file driver. +! Sets up use of the multi-file driver. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! mem_map - mapping array ! memb_fapl - property list for each memory usage type ! memb_name - names of member file -! relax - flag +! relax - flag ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4089,10 +4097,10 @@ CONTAINS INTEGER, DIMENSION(*), INTENT(IN) :: memb_map INTEGER(HID_T), DIMENSION(*), INTENT(IN) :: memb_fapl CHARACTER(LEN=*), DIMENSION(*), INTENT(IN) :: memb_name - REAL, DIMENSION(*), INTENT(IN) :: memb_addr + REAL, DIMENSION(*), INTENT(IN) :: memb_addr LOGICAL, INTENT(IN) :: relax INTEGER, INTENT(OUT) :: hdferr -!***** +!***** INTEGER, DIMENSION(1:H5FD_MEM_NTYPES_F) :: lenm INTEGER :: maxlen INTEGER :: flag = 0 @@ -4105,7 +4113,7 @@ CONTAINS IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, DIMENSION(*), INTENT(IN) :: memb_map INTEGER(HID_T), DIMENSION(*), INTENT(IN) :: memb_fapl CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: memb_name @@ -4124,21 +4132,21 @@ CONTAINS hdferr = h5pset_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag) END SUBROUTINE h5pset_fapl_multi_l -!****s* H5P/h5pset_fapl_multi_s +!****s* H5P/h5pset_fapl_multi_s ! NAME -! h5pset_fapl_multi_s +! h5pset_fapl_multi_s ! ! PURPOSE -! Sets up use of the multi-file driver. +! Sets up use of the multi-file driver. ! ! INPUTS -! +! ! prp_id - file creation property list identifier -! relax - flag +! relax - flag ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4147,11 +4155,11 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pset_fapl_multi_s(prp_id, relax, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier LOGICAL, INTENT(IN) :: relax INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: flag INTERFACE @@ -4159,37 +4167,37 @@ CONTAINS BIND(C,NAME='h5pset_fapl_multi_sc') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, INTENT(IN) :: flag END FUNCTION h5pset_fapl_multi_sc END INTERFACE flag = 0 IF (relax) flag = 1 - hdferr = h5pset_fapl_multi_sc(prp_id, flag) - + hdferr = h5pset_fapl_multi_sc(prp_id, flag) + END SUBROUTINE h5pset_fapl_multi_s -!****s* H5P/h5pget_fapl_multi_f +!****s* H5P/h5pget_fapl_multi_f ! NAME -! h5pget_fapl_multi_f +! h5pget_fapl_multi_f ! ! PURPOSE -! Sets up use of the multi-file driver. +! Sets up use of the multi-file driver. ! ! INPUTS -! +! ! prp_id - file creation property list identifier ! OUTPUTS -! +! ! mem_map - mapping array ! memb_fapl - property list for each memory usage type ! memb_name - names of member file -! relax - flag -! hdferr - error code +! relax - flag +! hdferr - error code ! Success: 0 ! Failure: -1 ! ! OPTIONAL PARAMETERS -! maxlen_out - maximum length for memb_name array element +! maxlen_out - maximum length for memb_name array element ! ! AUTHOR ! Elena Pourmal @@ -4198,19 +4206,19 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pget_fapl_multi_f(prp_id, memb_map, memb_fapl, memb_name, memb_addr, relax, hdferr, maxlen_out) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, DIMENSION(*), INTENT(OUT) :: memb_map INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: memb_fapl CHARACTER(LEN=*), DIMENSION(*), INTENT(OUT) :: memb_name REAL, DIMENSION(*), INTENT(OUT) :: memb_addr - INTEGER, OPTIONAL, INTENT(OUT) :: maxlen_out + INTEGER, OPTIONAL, INTENT(OUT) :: maxlen_out LOGICAL, INTENT(OUT) :: relax INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER, DIMENSION(1:H5FD_MEM_NTYPES_F) :: lenm INTEGER :: maxlen - INTEGER :: c_maxlen_out + INTEGER :: c_maxlen_out INTEGER :: flag INTEGER :: i ! @@ -4221,14 +4229,14 @@ CONTAINS IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, DIMENSION(*), INTENT(OUT) :: memb_map INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: memb_fapl CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: memb_name REAL, DIMENSION(*), INTENT(OUT) :: memb_addr INTEGER, DIMENSION(*) :: lenm INTEGER :: maxlen - INTEGER :: c_maxlen_out + INTEGER :: c_maxlen_out INTEGER, INTENT(OUT) :: flag END FUNCTION h5pget_fapl_multi_c END INTERFACE @@ -4238,20 +4246,20 @@ CONTAINS lenm(i) = LEN_TRIM(memb_name(i)) ENDDO hdferr = h5pget_fapl_multi_c(prp_id, memb_map, memb_fapl, memb_name, lenm, maxlen, memb_addr, flag, c_maxlen_out) - + relax = .TRUE. IF(flag .EQ. 0) relax = .FALSE. IF(PRESENT(maxlen_out)) maxlen_out = c_maxlen_out END SUBROUTINE h5pget_fapl_multi_f -!****s* H5P/h5pset_szip_f +!****s* H5P/h5pset_szip_f ! NAME -! h5pset_szip_f +! h5pset_szip_f ! ! PURPOSE ! Sets up use of szip compression ! ! INPUTS -! +! ! prp_id - dataset creation property list identifier ! options_mask - A bit-mask conveying the desired SZIP options. ! Current valid values in Fortran are: @@ -4259,25 +4267,25 @@ CONTAINS ! H5_SZIP_NN_OM_F ! pixels_per_block - szip parameters ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal ! April 10 2003 ! ! Fortran90 Interface: - SUBROUTINE h5pset_szip_f(prp_id, options_mask, pixels_per_block, hdferr) + SUBROUTINE h5pset_szip_f(prp_id, options_mask, pixels_per_block, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property - ! list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property + ! list identifier INTEGER, INTENT(IN) :: options_mask ! A bit-mask conveying the desired ! SZIP options ! Current valid values in Fortran are: ! H5_SZIP_EC_OM_F ! H5_SZIP_NN_OM_F - INTEGER, INTENT(IN) :: pixels_per_block ! The number of pixels or data elements + INTEGER, INTENT(IN) :: pixels_per_block ! The number of pixels or data elements ! in each data block INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure @@ -4287,33 +4295,33 @@ CONTAINS BIND(C,NAME='h5pset_szip_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! File creation property list identifier INTEGER, INTENT(IN) :: options_mask INTEGER, INTENT(IN) :: pixels_per_block END FUNCTION h5pset_szip_c END INTERFACE - hdferr = h5pset_szip_c(prp_id, options_mask, pixels_per_block) - + hdferr = h5pset_szip_c(prp_id, options_mask, pixels_per_block) + END SUBROUTINE h5pset_szip_f -!****s* H5P/h5pall_filters_avail_f +!****s* H5P/h5pall_filters_avail_f ! NAME -! h5pall_filters_avail_f +! h5pall_filters_avail_f ! ! PURPOSE ! Checks if all filters set in the dataset creation ! property list are available ! ! INPUTS -! +! ! prp_id - data creation property list identifier ! OUTPUTS -! +! ! flag - .TRUE. if all filters are available ! .FALSE. otherwise -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4322,13 +4330,13 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pall_filters_avail_f(prp_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property - ! list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Dataset creation property + ! list identifier LOGICAL, INTENT(OUT) :: flag ! .TRUE. if all filters are available ! .FALSE. otherwise INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: status INTERFACE @@ -4341,24 +4349,24 @@ CONTAINS END FUNCTION h5pall_filters_avail_c END INTERFACE flag = .TRUE. - hdferr = h5pall_filters_avail_c(prp_id, status) + hdferr = h5pall_filters_avail_c(prp_id, status) IF (status .EQ. 0 ) flag = .FALSE. - + END SUBROUTINE h5pall_filters_avail_f !****s* H5P/h5pget_filter_by_id_f ! NAME -! h5pget_filter_by_id_f +! h5pget_filter_by_id_f ! ! PURPOSE ! Returns information about a filter in a pipeline ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier ! OUTPUTS -! +! ! filter_id - filter identifier ! flags - bit vector specifying certain general ! properties of the filter @@ -4366,9 +4374,9 @@ CONTAINS ! cd_values - auxiliary data for the filter ! namelen - number of characters in the name buffer ! name - buffer to retrieve filter name -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4377,7 +4385,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pget_filter_by_id_f(prp_id, filter_id, flags, cd_nelmts, cd_values, namelen, name, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter_id ! Filter identifier INTEGER(SIZE_T), INTENT(INOUT) :: cd_nelmts ! Number of elements in cd_values. INTEGER, DIMENSION(*), INTENT(OUT) :: cd_values ! Auxiliary data for the filter. @@ -4396,29 +4404,29 @@ CONTAINS IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: filter_id + INTEGER, INTENT(IN) :: filter_id INTEGER, DIMENSION(*), INTENT(OUT) :: cd_values - INTEGER, INTENT(OUT) :: flags + INTEGER, INTENT(OUT) :: flags INTEGER(SIZE_T), INTENT(INOUT) :: cd_nelmts INTEGER(SIZE_T), INTENT(IN) :: namelen CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name END FUNCTION h5pget_filter_by_id_c END INTERFACE - - hdferr = h5pget_filter_by_id_c(prp_id, filter_id, flags, cd_nelmts, & + + hdferr = h5pget_filter_by_id_c(prp_id, filter_id, flags, cd_nelmts, & cd_values, namelen, name) END SUBROUTINE h5pget_filter_by_id_f !****s* H5P/h5pmodify_filter_f ! NAME -! h5pmodify_filter_f +! h5pmodify_filter_f ! ! PURPOSE -! Adds a filter to the filter pipeline. +! Adds a filter to the filter pipeline. ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier ! filter - filter to be modified ! flags - bit vector specifying certain general @@ -4426,9 +4434,9 @@ CONTAINS ! cd_nelmts - number of elements in cd_values ! cd_values - auxiliary data for the filter ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Elena Pourmal @@ -4437,7 +4445,7 @@ CONTAINS ! Fortran90 Interface: SUBROUTINE h5pmodify_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier INTEGER, INTENT(IN) :: filter ! Filter to be modified INTEGER, INTENT(IN) :: flags ! Bit vector specifying certain general ! properties of the filter @@ -4451,33 +4459,33 @@ CONTAINS BIND(C,NAME='h5pmodify_filter_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: filter - INTEGER, INTENT(IN) :: flags - INTEGER(SIZE_T), INTENT(IN) :: cd_nelmts - INTEGER, DIMENSION(*), INTENT(IN) :: cd_values + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, INTENT(IN) :: filter + INTEGER, INTENT(IN) :: flags + INTEGER(SIZE_T), INTENT(IN) :: cd_nelmts + INTEGER, DIMENSION(*), INTENT(IN) :: cd_values END FUNCTION h5pmodify_filter_c END INTERFACE - + hdferr = h5pmodify_filter_c(prp_id, filter, flags, cd_nelmts, cd_values ) END SUBROUTINE h5pmodify_filter_f -!****s* H5P/h5premove_filter_f +!****s* H5P/h5premove_filter_f ! NAME -! h5premove_filter_f +! h5premove_filter_f ! ! PURPOSE -! Delete one or more filters from the filter pipeline. +! Delete one or more filters from the filter pipeline. ! ! INPUTS -! -! prp_id - data creation or transfer property list +! +! prp_id - data creation or transfer property list ! identifier ! filter - filter to be removed ! OUTPUTS -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! Quincey Koziol @@ -4497,39 +4505,39 @@ CONTAINS BIND(C,NAME='h5premove_filter_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id - INTEGER, INTENT(IN) :: filter + INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER, INTENT(IN) :: filter END FUNCTION h5premove_filter_c END INTERFACE - + hdferr = h5premove_filter_c(prp_id, filter) END SUBROUTINE h5premove_filter_f !****s* H5P/H5Pget_attr_phase_change_f ! NAME -! H5Pget_attr_phase_change_f +! H5Pget_attr_phase_change_f ! ! PURPOSE -! Retrieves attribute storage phase change thresholds +! Retrieves attribute storage phase change thresholds ! ! INPUTS -! +! ! ocpl_id - Object (dataset or group) creation property list identifier ! OUTPUTS -! +! ! max_compact - Maximum number of attributes to be stored in compact storage ! (Default: 8) ! min_dense - Minimum number of attributes to be stored in dense storage ! (Default: 6) -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! January, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier @@ -4555,28 +4563,28 @@ CONTAINS hdferr = h5pget_attr_phase_change_c(ocpl_id, max_compact, min_dense) END SUBROUTINE h5pget_attr_phase_change_f -!****s* H5P/H5Pset_attr_creation_order_f +!****s* H5P/H5Pset_attr_creation_order_f ! NAME -! H5Pset_attr_creation_order_f +! H5Pset_attr_creation_order_f ! ! PURPOSE ! Sets tracking and indexing of attribute creation order ! ! INPUTS -! +! ! ocpl_id - Object creation property list identifier ! crt_order_flags - Flags specifying whether to track and index attribute creation order ! OUTPUTS ! -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! January, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_attr_creation_order_f(ocpl_id, crt_order_flags , hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier @@ -4598,36 +4606,36 @@ CONTAINS hdferr = H5Pset_attr_creation_order_c(ocpl_id, crt_order_flags) END SUBROUTINE h5pset_attr_creation_order_f -!****s* H5P/H5Pset_shared_mesg_nindexes_f +!****s* H5P/H5Pset_shared_mesg_nindexes_f ! NAME -! H5Pset_shared_mesg_nindexes_f +! H5Pset_shared_mesg_nindexes_f ! ! PURPOSE -! Sets number of shared object header message indexes +! Sets number of shared object header message indexes ! ! INPUTS -! +! ! plist_id - file creation property list ! nindexes - Number of shared object header message indexes to be available in files created with this property list ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! January, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_shared_mesg_nindexes_f( plist_id, nindexes, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list - INTEGER, INTENT(IN) :: nindexes ! Number of shared object header message indexes + INTEGER, INTENT(IN) :: nindexes ! Number of shared object header message indexes ! available in files created WITH this property list INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** ! ! MS FORTRAN needs explicit interface for C functions called here. ! @@ -4654,7 +4662,7 @@ CONTAINS ! Configures the specified shared object header message index ! ! INPUTS -! +! ! fcpl_id - File creation property list identifier. ! index_num - Index being configured. ! mesg_type_flags - Types of messages that should be stored in this index. @@ -4662,15 +4670,15 @@ CONTAINS ! ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! January, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_shared_mesg_index_f(fcpl_id, index_num, mesg_type_flags, min_mesg_size, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl_id ! file creation property list @@ -4679,7 +4687,7 @@ CONTAINS INTEGER, INTENT(IN) :: min_mesg_size ! Minimum message size. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** ! ! MS FORTRAN needs explicit interface for C functions called here. ! @@ -4688,7 +4696,7 @@ CONTAINS BIND(C,NAME='h5pset_shared_mesg_index_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fcpl_id + INTEGER(HID_T), INTENT(IN) :: fcpl_id INTEGER, INTENT(IN) :: index_num INTEGER, INTENT(IN) :: mesg_type_flags INTEGER, INTENT(IN) :: min_mesg_size @@ -4713,22 +4721,22 @@ CONTAINS ! OUTPUTS ! ! crt_order_flags - Flags specifying whether to track and index attribute creation order -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_attr_creation_order_f(ocpl_id, crt_order_flags, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (group or dataset) creation property list identifier - INTEGER, INTENT(OUT) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order + INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (group or dataset) creation property list identifier + INTEGER, INTENT(OUT) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** ! ! MS FORTRAN needs explicit interface for C functions called here. ! @@ -4746,6 +4754,65 @@ CONTAINS END SUBROUTINE h5pget_attr_creation_order_f +!****s* H5P/H5Pget_libver_bounds_f +! NAME +! H5Pget_libver_bounds_f +! +! PURPOSE +! Retrieves the lower and upper bounds on the HDF5 library release versions that indirectly +! determine the object format versions used when creating objects in the file. +! +! INPUTS +! +! fapl_id - File access property list identifier +! low - The earliest version of the library that will be used for writing objects. +! high - The latest version of the library that will be used for writing objects. +! +! OUTPUTS +! +! hdferr - error code +! Success: 0 +! Failure: -1 +! +! AUTHOR +! M. Scot Breitenfeld +! February 10, 2020 +! +! Fortran Interface: + SUBROUTINE h5pget_libver_bounds_f(fapl_id, low, high, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier + INTEGER, INTENT(OUT) :: low ! The earliest version of the library that will be used for writing objects. + INTEGER, INTENT(OUT) :: high ! The latest version of the library that will be used for writing objects. + INTEGER, INTENT(OUT) :: hdferr ! Error code: 0 on success and -1 on failure +!***** +! Local variables + INTEGER(ENUM_T) :: low_c, high_c + INTEGER(C_INT) :: hdferr_c +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER(C_INT) FUNCTION h5pget_libver_bounds(fapl_id, low, high) & + BIND(C,NAME='H5Pget_libver_bounds') + IMPORT :: C_INT, HID_T, ENUM_T + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) , VALUE :: fapl_id + INTEGER(ENUM_T), INTENT(OUT) :: low + INTEGER(ENUM_T), INTENT(OUT) :: high + END FUNCTION h5pget_libver_bounds + END INTERFACE + + hdferr_c = H5Pget_libver_bounds(fapl_id, low_c, high_c) + + low = INT(low_c) + high = INT(high_c) + + hdferr = 0 + IF(hdferr_c.LT.0) hdferr = -1 + + END SUBROUTINE h5pget_libver_bounds_f + !****s* H5P/H5Pset_libver_bounds_f ! NAME ! H5Pset_libver_bounds_f @@ -4761,50 +4828,48 @@ CONTAINS ! ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 18, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_libver_bounds_f(fapl_id, low, high, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier - INTEGER, INTENT(IN) :: low ! The earliest version of the library that will be used for writing objects. - ! Currently, low must be one of two pre-defined values: - ! HDF_LIBVER_EARLIEST_F - ! HDF_LIBVER_LATEST_F - INTEGER, INTENT(IN) :: high ! The latest version of the library that will be used for writing objects. - ! Currently, low must set to the pre-defined value: - ! HDF_LIBVER_LATEST_F - INTEGER, INTENT(OUT) :: hdferr ! Error code - ! 0 on success and -1 on failure -!***** + INTEGER, INTENT(IN) :: low ! The earliest version of the library that will be used for writing objects. + INTEGER, INTENT(IN) :: high ! The latest version of the library that will be used for writing objects. + INTEGER, INTENT(OUT) :: hdferr ! Error code: 0 on success and -1 on failure +!***** +! Local variables + INTEGER(C_INT) :: hdferr_c ! ! MS FORTRAN needs explicit interface for C functions called here. ! INTERFACE - INTEGER FUNCTION h5pset_libver_bounds_c(fapl_id, low, high) & - BIND(C,NAME='h5pset_libver_bounds_c') - IMPORT :: HID_T + INTEGER(C_INT) FUNCTION h5pset_libver_bounds(fapl_id, low, high) & + BIND(C,NAME='H5Pset_libver_bounds') + IMPORT :: C_INT, HID_T, ENUM_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fapl_id - INTEGER, INTENT(IN) :: low - INTEGER, INTENT(IN) :: high - - END FUNCTION H5pset_libver_bounds_c + INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id + INTEGER(ENUM_T), INTENT(IN), VALUE :: low + INTEGER(ENUM_T), INTENT(IN), VALUE :: high + END FUNCTION h5pset_libver_bounds END INTERFACE - hdferr = h5pset_libver_bounds_c(fapl_id, low, high) + hdferr_c = h5pset_libver_bounds(fapl_id, INT(low, ENUM_T), INT(high, ENUM_T)) + + hdferr = 0 + IF(hdferr_c.LT.0) hdferr = -1 END SUBROUTINE h5pset_libver_bounds_f -!****s* H5P/H5Pset_link_creation_order_f +!****s* H5P/H5Pset_link_creation_order_f ! NAME -! H5Pset_link_creation_order_f +! H5Pset_link_creation_order_f ! ! PURPOSE ! Sets creation order tracking and indexing for links in a group. @@ -4816,15 +4881,15 @@ CONTAINS ! ! OUTPUTS ! -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 18, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! File access property list identifier @@ -4855,21 +4920,21 @@ CONTAINS ! Queries the settings for conversion between compact and dense groups. ! ! INPUTS -! +! ! gcpl_id - Group creation property list identifier ! OUTPUTS -! +! ! max_compact - Maximum number of attributes to be stored in compact storage ! min_dense - Minimum number of attributes to be stored in dense storage -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 20, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -4893,37 +4958,37 @@ CONTAINS hdferr = h5pget_link_phase_change_c(gcpl_id, max_compact, min_dense) END SUBROUTINE h5pget_link_phase_change_f -!****s* H5P/H5Pget_obj_track_times_f +!****s* H5P/H5Pget_obj_track_times_f ! NAME -! H5Pget_obj_track_times_f +! H5Pget_obj_track_times_f ! ! PURPOSE ! Returns whether times are tracked for an object. ! ! INPUTS -! +! ! plist_id - property list id ! flag - object timestamp setting ! .TRUE.,.FALSE. ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 22, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property - ! list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property + ! list identifier LOGICAL, INTENT(OUT) :: flag ! Object timestamp setting INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: status ! ! MS FORTRAN needs explicit interface for C functions called here. @@ -4932,7 +4997,7 @@ CONTAINS INTEGER FUNCTION h5pget_obj_track_times_c(plist_id, status) & BIND(C,NAME='h5pget_obj_track_times_c') IMPORT :: HID_T - INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier INTEGER, INTENT(OUT) :: status END FUNCTION h5pget_obj_track_times_c END INTERFACE @@ -4942,9 +5007,9 @@ CONTAINS END SUBROUTINE h5pget_obj_track_times_f -!****s* H5P/H5Pset_obj_track_times_f +!****s* H5P/H5Pset_obj_track_times_f ! NAME -! H5Pset_obj_track_times_f +! H5Pset_obj_track_times_f ! ! PURPOSE ! Set whether the birth, access, modification & change times for @@ -4964,22 +5029,22 @@ CONTAINS ! epoch) when queried. ! ! INPUTS -! +! ! plist_id - property list id ! flag - object timestamp setting ! .TRUE.,.FALSE. ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 22, 2008 -! -! -! Fortran90 Interface: +! +! +! Fortran90 Interface: SUBROUTINE h5pset_obj_track_times_f(plist_id, flag, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property @@ -4987,7 +5052,7 @@ CONTAINS LOGICAL, INTENT(IN) :: flag ! Object timestamp setting INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: status ! ! MS FORTRAN needs explicit interface for C functions called here. @@ -4997,7 +5062,7 @@ CONTAINS BIND(C,NAME='h5pset_obj_track_times_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier + INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier INTEGER, INTENT(IN) :: status END FUNCTION h5pset_obj_track_times_c END INTERFACE @@ -5017,22 +5082,22 @@ CONTAINS ! Specifies in property list whether to create missing intermediate groups. ! ! INPUTS -! +! ! lcpl_id - Link creation property list identifier -! crt_intermed_group - crt_intermed_group specifying whether -! to create intermediate groups upon the creation +! crt_intermed_group - crt_intermed_group specifying whether +! to create intermediate groups upon the creation ! of an object ! OUTPUTS ! -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! February 22, 2008 ! -! HISTORY +! HISTORY ! The long subroutine name (>31) on older f90 compilers causes problems ! so had to shorten the name ! Fortran90 Interface: @@ -5072,15 +5137,15 @@ CONTAINS ! OUTPUTS ! ! crt_order_flags - Creation order flag(s) -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! March 3, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier @@ -5118,15 +5183,15 @@ CONTAINS ! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding ! ! OUTPUTS -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! March 3, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pset_char_encoding_f(plist_id, encoding, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -5167,15 +5232,15 @@ CONTAINS ! encoding - Valid values for encoding are: ! H5T_CSET_ASCII_F -> US ASCII ! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! March 3, 2008 ! -! Fortran90 Interface: +! Fortran90 Interface: SUBROUTINE h5pget_char_encoding_f(plist_id, encoding, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier @@ -5203,20 +5268,20 @@ CONTAINS !****s* H5P/h5pset_copy_object_f ! NAME -! h5pset_copy_object_f +! h5pset_copy_object_f ! ! PURPOSE ! Sets properties to be used when an object is copied. ! ! INPUTS -! +! ! ocp_plist_id - Object copy property list identifier ! copy_options - Copy option(s) to be set ! OUTPUTS -! -! hdferr - error code +! +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5224,8 +5289,8 @@ CONTAINS ! ! HISTORY ! -! -! Fortran90 Interface: +! +! Fortran90 Interface: SUBROUTINE h5pset_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier @@ -5252,20 +5317,20 @@ CONTAINS !****s* H5P/h5pget_copy_object_f ! NAME -! h5pget_copy_object_f +! h5pget_copy_object_f ! ! PURPOSE ! Retrieves the properties to be used when an object is copied. ! ! INPUTS -! +! ! ocp_plist_id - Object copy property list identifier ! OUTPUTS -! +! ! copy_options - Copy option(s) to be get -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5273,14 +5338,14 @@ CONTAINS ! ! HISTORY ! -! +! ! Fortran90 Interface: SUBROUTINE h5pget_copy_object_f(ocp_plist_id, copy_options, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier INTEGER, INTENT(OUT) :: copy_options ! Valid copy options returned are: ! H5O_COPY_SHALLOW_HIERARCHY_F - ! H5O_COPY_EXPAND_SOFT_LINK_F + ! H5O_COPY_EXPAND_SOFT_LINK_F ! H5O_COPY_EXPAND_EXT_LINK_F ! H5O_COPY_EXPAND_REFERENCE_F ! H5O_COPY_WITHOUT_ATTR_FLAG_F @@ -5299,23 +5364,23 @@ CONTAINS hdferr = h5pget_copy_object_c(ocp_plist_id, copy_options) END SUBROUTINE h5pget_copy_object_f -!****s* H5P/h5pget_data_transform_f +!****s* H5P/h5pget_data_transform_f ! NAME -! h5pget_data_transform_f +! h5pget_data_transform_f ! ! PURPOSE ! Retrieves a data transform expression. ! ! INPUTS -! +! ! plist_id - Identifier of the property list or class ! OUTPUTS -! +! ! expression - buffer to hold transform expression ! hdferr - Error code -! Success: Actual lenght of the expression -! If provided buffer "expression" is -! smaller, than expression will be +! Success: Actual length of the expression +! If provided buffer "expression" is +! smaller, than expression will be ! truncated to fit into ! provided user buffer ! Failure: -1 @@ -5335,7 +5400,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size ! Registered size of the transform expression INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: expression_len INTEGER(SIZE_T) :: size_default @@ -5345,8 +5410,8 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: expression + INTEGER(HID_T), INTENT(IN) :: plist_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: expression INTEGER(SIZE_T) :: size_default INTEGER :: expression_len END FUNCTION h5pget_data_transform_c @@ -5361,19 +5426,19 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) END SUBROUTINE h5pget_data_transform_f -!****s* H5P/h5pset_data_transform_f +!****s* H5P/h5pset_data_transform_f ! NAME -! h5pset_data_transform_f +! h5pset_data_transform_f ! ! PURPOSE ! Sets a data transform expression. ! ! INPUTS -! -! plist_id - Identifier of the property list or class +! +! plist_id - Identifier of the property list or class ! expression - Buffer to hold transform expression ! OUTPUTS -! +! ! hdferr - error code ! Success: 0 ! Failure: -1 @@ -5389,7 +5454,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) CHARACTER(LEN=*), INTENT(IN) :: expression ! Buffer to hold transform expression INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTEGER :: expression_len INTERFACE @@ -5398,7 +5463,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) IMPORT :: C_CHAR IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER(HID_T), INTENT(IN) :: plist_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: expression INTEGER :: expression_len END FUNCTION h5pset_data_transform_c @@ -5409,15 +5474,15 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) END SUBROUTINE h5pset_data_transform_f -!****s* H5P/H5Pget_local_heap_size_hint_f +!****s* H5P/H5Pget_local_heap_size_hint_f ! NAME -! H5Pget_local_heap_size_hint_f +! H5Pget_local_heap_size_hint_f ! ! PURPOSE ! Queries the local heap size hint for original-style groups. ! ! INPUTS -! +! ! gcpl_id - Group creation property list identifier ! OUTPUTS ! @@ -5452,18 +5517,18 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) END SUBROUTINE h5pget_local_heap_size_hint_f -!****s* H5P/H5Pget_est_link_info_f +!****s* H5P/H5Pget_est_link_info_f ! NAME -! H5Pget_est_link_info_f +! H5Pget_est_link_info_f ! ! PURPOSE ! Queries data required to estimate required local heap or object header size. ! ! INPUTS -! +! ! gcpl_id - Group creation property list identifier ! OUTPUTS -! +! ! est_num_entries - Estimated number of links to be inserted into group ! est_name_len - Estimated average length of link names ! hdferr - Error code @@ -5476,11 +5541,11 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! ! HISTORY ! -! +! ! Fortran90 Interface: SUBROUTINE h5pget_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(OUT) :: est_num_entries ! Estimated number of links to be inserted into group INTEGER, INTENT(OUT) :: est_name_len ! Estimated average length of link names INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -5491,7 +5556,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) BIND(C,NAME='h5pget_est_link_info_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER(HID_T), INTENT(IN) :: gcpl_id INTEGER, INTENT(OUT) :: est_num_entries INTEGER, INTENT(OUT) :: est_name_len END FUNCTION h5pget_est_link_info_c @@ -5501,15 +5566,15 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) END SUBROUTINE h5pget_est_link_info_f -!****s* H5P/H5Pset_local_heap_size_hint_f +!****s* H5P/H5Pset_local_heap_size_hint_f ! NAME -! H5Pset_local_heap_size_hint_f +! H5Pset_local_heap_size_hint_f ! ! PURPOSE ! Sets the local heap size hint for original-style groups. ! ! INPUTS -! +! ! gcpl_id - Group creation property list identifier ! size_hint - Hint for size of local heap ! OUTPUTS @@ -5533,7 +5598,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) INTERFACE INTEGER FUNCTION h5pset_local_heap_size_hint_c(gcpl_id, size_hint) & BIND(C,NAME='h5pset_local_heap_size_hint_c') - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: gcpl_id INTEGER(SIZE_T), INTENT(IN) :: size_hint @@ -5544,16 +5609,16 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) END SUBROUTINE h5pset_local_heap_size_hint_f -!****s* H5P/h5pset_est_link_info_f +!****s* H5P/h5pset_est_link_info_f ! NAME -! h5pset_est_link_info_f +! h5pset_est_link_info_f ! ! PURPOSE ! Sets estimated number of links and length of link names in a group. ! ! INPUTS -! -! gcpl_id - Group creation property list identifier +! +! gcpl_id - Group creation property list identifier ! est_num_entries - Estimated number of links to be inserted into group ! est_name_len - Estimated average length of link names ! OUTPUTS @@ -5569,7 +5634,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! Fortran90 Interface: SUBROUTINE h5pset_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier INTEGER, INTENT(IN) :: est_num_entries ! Estimated number of links to be inserted into group INTEGER, INTENT(IN) :: est_name_len ! Estimated average length of link names INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -5580,7 +5645,7 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) BIND(C,NAME='h5pset_est_link_info_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER(HID_T), INTENT(IN) :: gcpl_id INTEGER, INTENT(IN) :: est_num_entries INTEGER, INTENT(IN) :: est_name_len END FUNCTION h5pset_est_link_info_c @@ -5598,15 +5663,15 @@ SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) ! Sets the parameters for conversion between compact and dense groups. ! ! INPUTS -! -! gcpl_id - Group creation property list identifier +! +! gcpl_id - Group creation property list identifier ! max_compact - Maximum number of attributes to be stored in compact storage ! min_dense - Minimum number of attributes to be stored in dense storage ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5643,16 +5708,16 @@ SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) ! Sets up use of the direct I/O driver. ! ! INPUTS -! +! ! fapl_id - File access property list identifier ! alignment - Required memory alignment boundary ! block_size - File system block size ! cbuf_size - Copy buffer size ! OUTPUTS ! -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5660,7 +5725,7 @@ SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) ! ! Fortran90 Interface: SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) - IMPLICIT NONE + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(IN) :: alignment ! Required memory alignment boundary! INTEGER(SIZE_T), INTENT(IN) :: block_size ! File system block size @@ -5673,7 +5738,7 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer BIND(C,NAME='h5pset_fapl_direct_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fapl_id + INTEGER(HID_T), INTENT(IN) :: fapl_id INTEGER(SIZE_T), INTENT(IN) :: alignment INTEGER(SIZE_T), INTENT(IN) :: block_size INTEGER(SIZE_T), INTENT(IN) :: cbuf_size @@ -5691,16 +5756,16 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer ! Gets up use of the direct I/O driver. ! ! INPUTS -! +! ! fapl_id - File access property list identifier ! OUTPUTS ! ! alignment - Required memory alignment boundary ! block_size - File system block size ! cbuf_size - Copy buffer size -! hdferr - error code +! hdferr - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5708,7 +5773,7 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer ! ! Fortran90 Interface: SUBROUTINE h5pget_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) - IMPLICIT NONE + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(OUT) :: alignment ! Required memory alignment boundary! INTEGER(SIZE_T), INTENT(OUT) :: block_size ! File system block size @@ -5721,7 +5786,7 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer BIND(C,NAME='h5pget_fapl_direct_c') IMPORT :: HID_T, SIZE_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: fapl_id + INTEGER(HID_T), INTENT(IN) :: fapl_id INTEGER(SIZE_T), INTENT(OUT) :: alignment INTEGER(SIZE_T), INTENT(OUT) :: block_size INTEGER(SIZE_T), INTENT(OUT) :: cbuf_size @@ -5733,23 +5798,23 @@ SUBROUTINE h5pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdfer !****s* H5P/H5Pset_attr_phase_change_f ! NAME -! H5Pset_attr_phase_change_f +! H5Pset_attr_phase_change_f ! ! PURPOSE ! Sets attribute storage phase change thresholds. ! ! INPUTS -! +! ! ocpl_id - Object (dataset or group) creation property list identifier ! OUTPUTS -! +! ! max_compact - Maximum number of attributes to be stored in compact storage ! (Default: 8) ! min_dense - Minimum number of attributes to be stored in dense storage ! (Default: 6) -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -5785,7 +5850,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !****s* H5P/H5Pset_nbit_f ! NAME -! H5Pset_nbit_f +! H5Pset_nbit_f ! ! PURPOSE ! Sets up the use of the N-Bit filter. @@ -5821,7 +5886,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !****s* H5P/h5pset_scaleoffset_f ! NAME -! h5pset_scaleoffset_f +! h5pset_scaleoffset_f ! ! PURPOSE ! Sets up the use of the scale-offset filter. @@ -5849,7 +5914,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER , INTENT(IN) :: scale_type INTEGER , INTENT(IN) :: scale_factor INTEGER , INTENT(OUT) :: hdferr -!***** +!***** INTERFACE INTEGER FUNCTION h5pset_scaleoffset_c(plist_id, scale_type, scale_factor) & @@ -5866,15 +5931,15 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END SUBROUTINE h5pset_scaleoffset_f -!****s* H5P/h5pset_nlinks_f +!****s* H5P/h5pset_nlinks_f ! NAME -! h5pset_nlinks_f +! h5pset_nlinks_f ! ! PURPOSE ! Sets maximum number of soft or user-defined link traversals. ! ! INPUTS -! +! ! lapl_id - File access property list identifier ! nlinks - Maximum number of links to traverse ! @@ -5890,15 +5955,15 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! HISTORY ! -! +! ! Fortran90 Interface: SUBROUTINE h5pset_nlinks_f(lapl_id, nlinks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier INTEGER(SIZE_T), INTENT(IN) :: nlinks ! Maximum number of links to traverse - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pset_nlinks_c(lapl_id, nlinks) & BIND(C,NAME='h5pset_nlinks_c') @@ -5913,15 +5978,15 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END SUBROUTINE h5pset_nlinks_f -!****s* H5P/h5pget_nlinks_f +!****s* H5P/h5pget_nlinks_f ! NAME -! h5pget_nlinks_f +! h5pget_nlinks_f ! ! PURPOSE ! Gets maximum number of soft or user-defined link traversals. ! ! INPUTS -! +! ! lapl_id - File access property list identifier ! nlinks - Maximum number of links to traverse ! @@ -5946,7 +6011,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTERFACE INTEGER FUNCTION h5pget_nlinks_c(lapl_id, nlinks) & BIND(C,NAME='h5pget_nlinks_c') - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: lapl_id INTEGER(SIZE_T), INTENT(OUT) :: nlinks @@ -5965,22 +6030,22 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Determines whether property is set to enable creating missing intermediate groups. ! ! INPUTS -! +! ! lcpl_id - Link creation property list identifier -! crt_intermed_group - Specifying whether to create intermediate groups upon +! crt_intermed_group - Specifying whether to create intermediate groups upon ! the creation of an object ! OUTPUTS ! -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld ! April 4, 2008 ! ! HISTORY -! +! ! The long subroutine name (>31) on older f90 compilers causes problems ! so the name was shortened ! Fortran90 Interface: @@ -5991,7 +6056,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! upon creation of an object INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pget_create_inter_group_c(lcpl_id, crt_intermed_group) & BIND(C,NAME='h5pget_create_inter_group_c') @@ -6030,16 +6095,16 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! other chunks. ! ! INPUTS -! +! ! dapl_id - Dataset access property list identifier. ! rdcc_nslots - The number of chunk slots in the raw data chunk cache for this dataset. ! rdcc_nbytes - The total size of the raw data chunk cache for this dataset. ! rdcc_w0 - The chunk preemption policy for this dataset. ! OUTPUTS ! -! hdferr - Error code +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -6051,19 +6116,19 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) SUBROUTINE h5pset_chunk_cache_f(dapl_id, rdcc_nslots, rdcc_nbytes, rdcc_w0, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dapl_id ! Dataset access property list identifier. - INTEGER(SIZE_T), INTENT(IN) :: rdcc_nslots ! The number of chunk slots in the raw data + INTEGER(SIZE_T), INTENT(IN) :: rdcc_nslots ! The number of chunk slots in the raw data ! chunk cache for this dataset. - INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes ! The total size of the raw data chunk cache + INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes ! The total size of the raw data chunk cache ! for this dataset. REAL, INTENT(IN) :: rdcc_w0 ! The chunk preemption policy for this dataset. INTEGER, INTENT(OUT) :: hdferr ! Error code ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pset_chunk_cache_c(dapl_id, rdcc_nslots, rdcc_nbytes, rdcc_w0) & BIND(C,NAME='h5pset_chunk_cache_c') - IMPORT :: HID_T, SIZE_T + IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dapl_id INTEGER(SIZE_T), INTENT(IN) :: rdcc_nslots @@ -6090,16 +6155,16 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! file access property list are returned. ! ! INPUTS -! +! ! dapl_id - Dataset access property list identifier. ! OUTPUTS -! -! rdcc_nslots - Number of chunk slots in the raw data chunk cache hash table. -! rdcc_nbytes - Total size of the raw data chunk cache, in bytes. -! rdcc_w0 - Preemption policy. -! hdferr - Error code +! +! rdcc_nslots - Number of chunk slots in the raw data chunk cache hash table. +! rdcc_nbytes - Total size of the raw data chunk cache, in bytes. +! rdcc_w0 - Preemption policy. +! hdferr - Error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! AUTHOR ! M. Scot Breitenfeld @@ -6112,11 +6177,11 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dapl_id ! Dataset access property list identifier. INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nslots ! Number of chunk slots in the raw data chunk cache hash table. - INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes ! Total size of the raw data chunk cache, in bytes. + INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes ! Total size of the raw data chunk cache, in bytes. REAL, INTENT(OUT) :: rdcc_w0 ! Preemption policy. INTEGER, INTENT(OUT) :: hdferr ! Error code: ! 0 on success and -1 on failure -!***** +!***** INTERFACE INTEGER FUNCTION h5pget_chunk_cache_c(dapl_id, rdcc_nslots, rdcc_nbytes, rdcc_w0) & BIND(C,NAME='h5pget_chunk_cache_c') @@ -6169,7 +6234,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! INTEGER, REAL, DOUBLE PRECISION and CHARACTER dtatypes. ! ! Fortran90 Interface: -!! SUBROUTINE h5pset_fill_value_f(prp_id, type_id, fillvalue, hdferr) +!! SUBROUTINE h5pset_fill_value_f(prp_id, type_id, fillvalue, hdferr) !! IMPLICIT NONE !! INTEGER(HID_T), INTENT(IN) :: prp_id !! INTEGER(HID_T), INTENT(IN) :: type_id @@ -6230,7 +6295,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! Fortran90 Interface: !! SUBROUTINE h5pget_fill_value_f(prp_id, type_id, fillvalue, hdferr) -!! INTEGER(HID_T), INTENT(IN) :: prp_id +!! INTEGER(HID_T), INTENT(IN) :: prp_id !! INTEGER(HID_T), INTENT(IN) :: type_id !! TYPE(VOID) , INTENT(OUT) :: fillvalue !! INTEGER , INTENT(OUT) :: hdferr @@ -6337,7 +6402,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! Fortran2003 Interface: !! SUBROUTINE h5pset_fill_value_f(prp_id, type_id, fillvalue, hdferr) -!! INTEGER(HID_T), INTENT(IN) :: prp_id +!! INTEGER(HID_T), INTENT(IN) :: prp_id !! INTEGER(HID_T), INTENT(IN) :: type_id !! TYPE(C_PTR) , INTENT(IN) :: fillvalue !! INTEGER , INTENT(OUT) :: hdferr @@ -6393,7 +6458,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! Fortran2003 Interface: !! SUBROUTINE h5pget_fill_value_f(prp_id, type_id, fillvalue, hdferr) -!! INTEGER(HID_T), INTENT(IN) :: prp_id +!! INTEGER(HID_T), INTENT(IN) :: prp_id !! INTEGER(HID_T), INTENT(IN) :: type_id !! TYPE(C_PTR) :: fillvalue !! INTEGER , INTENT(OUT) :: hdferr @@ -6685,7 +6750,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !! CHARACTER(LEN=*), INTENT(IN) :: name !! INTEGER(SIZE_T) , INTENT(IN) :: size !! TYPE , INTENT(IN) :: value -!! INTEGER , INTENT(OUT) :: hdferr +!! INTEGER , INTENT(OUT) :: hdferr !***** SUBROUTINE h5pregister_integer(class, name, size, value, hdferr) IMPLICIT NONE @@ -6767,7 +6832,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !! CHARACTER(LEN=*), INTENT(IN) :: name !! INTEGER(SIZE_T) , INTENT(IN) :: size !! TYPE(C_PTR) , INTENT(IN) :: value -!! INTEGER , INTENT(OUT) :: hdferr +!! INTEGER , INTENT(OUT) :: hdferr !***** SUBROUTINE h5pregister_ptr(class, name, size, value, hdferr) @@ -6886,7 +6951,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Outputs: ! hdferr - Returns 0 if successful and -1 if fails ! -! AUTHOR +! AUTHOR ! M. Scot Breitenfeld ! June 24, 2008 ! @@ -7012,7 +7077,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! Inputs: ! fapl_id - File access property list identifier -! buf_ptr - Pointer to the initial file image, +! buf_ptr - Pointer to the initial file image, ! or C_NULL_PTR if no initial file image is desired ! buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired ! @@ -7052,7 +7117,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pget_file_image_f ! ! PURPOSE -! Retrieves a copy of the file image designated as the initial content and structure of a file. +! Retrieves a copy of the file image designated as the initial content and structure of a file. ! ! Inputs: ! fapl_id - File access property list identifier. @@ -7084,7 +7149,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) TYPE(C_PTR) , INTENT(OUT), DIMENSION(*) :: buf_ptr INTEGER(SIZE_T), INTENT(OUT) :: buf_len_ptr INTEGER , INTENT(OUT) :: hdferr - + !***** INTERFACE INTEGER FUNCTION h5pget_file_image_c(fapl_id, buf_ptr, buf_len_ptr) & @@ -7140,7 +7205,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) BIND(C,NAME='h5pset_fapl_mpio_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER , INTENT(IN) :: comm INTEGER , INTENT(IN) :: info END FUNCTION h5pset_fapl_mpio_c @@ -7183,7 +7248,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) BIND(C,NAME='h5pget_fapl_mpio_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER , INTENT(OUT) :: comm INTEGER , INTENT(OUT) :: info END FUNCTION h5pget_fapl_mpio_c @@ -7226,7 +7291,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) BIND(C,NAME='h5pset_dxpl_mpio_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER , INTENT(IN) :: data_xfer_mode END FUNCTION h5pset_dxpl_mpio_c END INTERFACE @@ -7268,7 +7333,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) BIND(C,NAME='h5pget_dxpl_mpio_c') IMPORT :: HID_T IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id + INTEGER(HID_T), INTENT(IN) :: prp_id INTEGER , INTENT(OUT) :: data_xfer_mode END FUNCTION h5pget_dxpl_mpio_c END INTERFACE @@ -7281,8 +7346,8 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pget_mpio_actual_io_mode_f ! ! PURPOSE -! Retrieves the type of I/O that HDF5 actually performed on the last -! parallel I/O call. This is not necessarily the type of I/O requested. +! Retrieves the type of I/O that HDF5 actually performed on the last +! parallel I/O call. This is not necessarily the type of I/O requested. ! ! INPUTS ! dxpl_id - Dataset transfer property list identifier. @@ -7302,7 +7367,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER(HID_T), INTENT(IN) :: dxpl_id INTEGER , INTENT(OUT) :: actual_io_mode INTEGER , INTENT(OUT) :: hdferr -!***** +!***** INTERFACE INTEGER FUNCTION h5pget_mpio_actual_io_mode_c(dxpl_id, actual_io_mode) & BIND(C,NAME='h5pget_mpio_actual_io_mode_c') @@ -7324,9 +7389,9 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pset_all_coll_metadata_ops_f ! ! PURPOSE -! Sets requirement whether HDF5 metadata read operations using the access property -! list are required to be collective or independent. If collective requirement is -! selected, the HDF5 library will optimize the metadata reads improving performance. +! Sets requirement whether HDF5 metadata read operations using the access property +! list are required to be collective or independent. If collective requirement is +! selected, the HDF5 library will optimize the metadata reads improving performance. ! The default setting is independent (false). ! ! INPUTS @@ -7349,7 +7414,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER, INTENT(OUT) :: hdferr !***** LOGICAL(C_BOOL) :: c_is_collective - + INTERFACE INTEGER FUNCTION h5pset_all_coll_metadata_ops(plist_id, is_collective) BIND(C, NAME='H5Pset_all_coll_metadata_ops') IMPORT :: HID_T, C_BOOL @@ -7361,12 +7426,12 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Transfer value of Fortran LOGICAL to C c_bool type c_is_collective = is_collective - + hdferr = INT(H5Pset_all_coll_metadata_ops(plist_id, c_is_collective)) - + END SUBROUTINE h5pset_all_coll_metadata_ops_f -!****s* H5P/h5pget_all_coll_metadata_ops_f +!****s* H5P/h5pget_all_coll_metadata_ops_f ! NAME ! h5pget_all_coll_metadata_ops_f ! @@ -7387,14 +7452,14 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! SOURCE SUBROUTINE h5pget_all_coll_metadata_ops_f(plist_id, is_collective, hdferr) - + IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: plist_id LOGICAL, INTENT(OUT) :: is_collective INTEGER, INTENT(OUT) :: hdferr !***** LOGICAL(C_BOOL) :: c_is_collective - + INTERFACE INTEGER FUNCTION h5pget_all_coll_metadata_ops(plist_id, is_collective) BIND(C, NAME='H5Pget_all_coll_metadata_ops') IMPORT :: HID_T, C_BOOL @@ -7403,12 +7468,12 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) LOGICAL(C_BOOL), INTENT(OUT) :: is_collective END FUNCTION h5pget_all_coll_metadata_ops END INTERFACE - + hdferr = INT(H5Pget_all_coll_metadata_ops(plist_id, c_is_collective)) - - ! Transfer value of C c_bool type to Fortran LOGICAL + + ! Transfer value of C c_bool type to Fortran LOGICAL is_collective = c_is_collective - + END SUBROUTINE h5pget_all_coll_metadata_ops_f !****s* H5P/h5pset_coll_metadata_write_f @@ -7438,7 +7503,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER, INTENT(OUT) :: hdferr !***** LOGICAL(C_BOOL) :: c_is_collective - + INTERFACE INTEGER FUNCTION h5pset_coll_metadata_write(plist_id, is_collective) BIND(C, NAME='H5Pset_coll_metadata_write') IMPORT :: HID_T, C_BOOL @@ -7447,12 +7512,12 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) LOGICAL(C_BOOL), INTENT(IN), VALUE :: is_collective END FUNCTION h5pset_coll_metadata_write END INTERFACE - + ! Transfer value of Fortran LOGICAL to C c_bool type c_is_collective = is_collective - + hdferr = INT(H5Pset_coll_metadata_write(plist_id, c_is_collective)) - + END SUBROUTINE h5pset_coll_metadata_write_f !****s* H5P/h5pget_coll_metadata_write_f @@ -7476,14 +7541,14 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! SOURCE SUBROUTINE h5pget_coll_metadata_write_f(plist_id, is_collective, hdferr) - + IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: plist_id LOGICAL, INTENT(OUT) :: is_collective INTEGER, INTENT(OUT) :: hdferr !***** LOGICAL(C_BOOL) :: c_is_collective - + INTERFACE INTEGER FUNCTION h5pget_coll_metadata_write(plist_id, is_collective) BIND(C, NAME='H5Pget_coll_metadata_write') IMPORT :: HID_T, C_BOOL @@ -7492,14 +7557,14 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) LOGICAL(C_BOOL), INTENT(OUT) :: is_collective END FUNCTION h5pget_coll_metadata_write END INTERFACE - + hdferr = INT(H5Pget_coll_metadata_write(plist_id, c_is_collective)) - - ! Transfer value of C c_bool type to Fortran LOGICAL + + ! Transfer value of C c_bool type to Fortran LOGICAL is_collective = c_is_collective - + END SUBROUTINE h5pget_coll_metadata_write_f - + #endif ! @@ -7519,9 +7584,9 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Valid values are: ! H5D_VDS_FIRST_MISSING_F ! H5D_VDS_LAST_AVAILABLE_F -! +! ! OUTPUTS -! +! ! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR @@ -7536,7 +7601,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER(HID_T), INTENT(IN) :: dapl_id INTEGER , INTENT(IN) :: view INTEGER , INTENT(OUT) :: hdferr - + !***** INTERFACE INTEGER FUNCTION h5pset_virtual_view(dapl_id, view) BIND(C,NAME='H5Pset_virtual_view') @@ -7548,7 +7613,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END INTERFACE hdferr = INT( h5pset_virtual_view(dapl_id, INT(view,ENUM_T)) ) - + END SUBROUTINE h5pset_virtual_view_f !****s* H5P/h5pget_virtual_view_f @@ -7556,7 +7621,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pget_virtual_view_f ! ! PURPOSE -! Retrieves the view of a virtual dataset accessed with dapl_id. +! Retrieves the view of a virtual dataset accessed with dapl_id. ! ! INPUTS ! dapl_id - Dataset access property list identifier for the virtual dataset @@ -7592,7 +7657,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) hdferr = INT( h5pget_virtual_view(dapl_id, view_enum) ) view = INT(view_enum) - + END SUBROUTINE h5pget_virtual_view_f !****s* H5P/h5pset_virtual_printf_gap_f @@ -7600,15 +7665,15 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pset_virtual_printf_gap_f ! ! PURPOSE -! Sets the maximum number of missing source files and/or datasets with the printf-style names -! when getting the extent of an unlimited virtual dataset. +! Sets the maximum number of missing source files and/or datasets with the printf-style names +! when getting the extent of an unlimited virtual dataset. ! ! INPUTS ! dapl_id - Dataset access property list identifier for the virtual dataset. -! gap_size - Maximum number of files and/or datasets allowed to be missing for determining +! gap_size - Maximum number of files and/or datasets allowed to be missing for determining ! the extent of an unlimited virtual dataset with printf-style mappings. ! -! OUTPUTS +! OUTPUTS ! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR @@ -7617,7 +7682,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! ! HISTORY ! -! SOURCE +! SOURCE SUBROUTINE h5pset_virtual_printf_gap_f(dapl_id, gap_size, hdferr) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: dapl_id @@ -7634,7 +7699,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END INTERFACE hdferr = INT( h5pset_virtual_printf_gap(dapl_id, gap_size) ) - + END SUBROUTINE h5pset_virtual_printf_gap_f !****s* H5P/h5pget_virtual_printf_gap_f @@ -7642,15 +7707,15 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! h5pget_virtual_printf_gap_f ! ! PURPOSE -! Returns the maximum number of missing source files and/or datasets with the +! Returns the maximum number of missing source files and/or datasets with the ! printf-style names when getting the extent for an unlimited virtual dataset. ! ! INPUTS ! dapl_id - Dataset access property list identifier for the virtual dataset ! ! OUTPUTS -! gap_size - Maximum number of the files and/or datasets allowed to be missing for -! determining the extent of an unlimited virtual dataset with printf-style mappings. +! gap_size - Maximum number of the files and/or datasets allowed to be missing for +! determining the extent of an unlimited virtual dataset with printf-style mappings. ! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR @@ -7662,7 +7727,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! SOURCE SUBROUTINE h5pget_virtual_printf_gap_f(dapl_id, gap_size, hdferr) IMPLICIT NONE - + INTEGER(HID_T) , INTENT(IN) :: dapl_id INTEGER(HSIZE_T), INTENT(OUT) :: gap_size INTEGER , INTENT(OUT) :: hdferr @@ -7677,7 +7742,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) END INTERFACE hdferr = INT( h5pget_virtual_printf_gap(dapl_id, gap_size) ) - + END SUBROUTINE h5pget_virtual_printf_gap_f !****s* H5P/h5pset_virtual_f @@ -7688,9 +7753,9 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Sets the mapping between virtual and source datasets. ! ! INPUTS -! dcpl_id - The identifier of the dataset creation property list that will be +! dcpl_id - The identifier of the dataset creation property list that will be ! used when creating the virtual dataset. -! vspace_id - The dataspace identifier with the selection within the virtual +! vspace_id - The dataspace identifier with the selection within the virtual ! dataset applied, possibly an unlimited selection. ! src_file_name - The name of the HDF5 file where the source dataset is located. ! src_dset_name - The path to the HDF5 dataset in the file specified by src_file_name. @@ -7708,7 +7773,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! SOURCE SUBROUTINE h5pset_virtual_f(dcpl_id, vspace_id, src_file_name, src_dset_name, src_space_id, hdferr) IMPLICIT NONE - + INTEGER(HID_T), INTENT(IN) :: dcpl_id INTEGER(HID_T), INTENT(IN) :: vspace_id CHARACTER(LEN=*), INTENT(IN) :: src_file_name @@ -7748,7 +7813,7 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! Gets the number of mappings for the virtual dataset. ! ! INPUTS -! dcpl_id - The identifier of the virtual dataset creation property list. +! dcpl_id - The identifier of the virtual dataset creation property list. ! ! OUTPUTS ! count - The number of mappings. @@ -7763,20 +7828,20 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) SUBROUTINE h5pget_virtual_count_f(dcpl_id, count, hdferr) IMPLICIT NONE - + INTEGER(HID_T), INTENT(IN) :: dcpl_id INTEGER(SIZE_T), INTENT(OUT) :: count INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE - INTEGER(HID_T) FUNCTION h5pget_virtual_count(dcpl_id, count) BIND(C,NAME='H5Pget_virtual_count') - IMPORT :: HID_T, SIZE_T + INTEGER(C_INT) FUNCTION h5pget_virtual_count(dcpl_id, count) BIND(C,NAME='H5Pget_virtual_count') + IMPORT :: HID_T, SIZE_T, C_INT IMPLICIT NONE INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id INTEGER(SIZE_T), INTENT(OUT) :: count END FUNCTION h5pget_virtual_count END INTERFACE - + hdferr = INT( h5pget_virtual_count(dcpl_id, count)) END SUBROUTINE h5pget_virtual_count_f @@ -7791,10 +7856,10 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) ! INPUTS ! dcpl_id - The identifier of the virtual dataset creation property list. ! index - Mapping index. -! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), ! where count is the number of mappings returned by h5pget_virtual_count. ! -! OUTPUTS +! OUTPUTS ! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR @@ -7821,9 +7886,9 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) INTEGER(SIZE_T), INTENT(IN), VALUE :: index END FUNCTION h5pget_virtual_vspace END INTERFACE - + ds_id = h5pget_virtual_vspace(dcpl_id, index) - + hdferr = 0 IF(ds_id.LT.0) hdferr = -1 @@ -7839,7 +7904,7 @@ END SUBROUTINE h5pget_virtual_vspace_f ! INPUTS ! dcpl_id - The identifier of the virtual dataset creation property list. ! index - Mapping index. -! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), ! where count is the number of mappings returned by h5pget_virtual_count. ! ! @@ -7871,7 +7936,7 @@ SUBROUTINE h5pget_virtual_srcspace_f(dcpl_id, index, ds_id, hdferr) INTEGER(SIZE_T), INTENT(IN), VALUE :: index END FUNCTION h5pget_virtual_srcspace END INTERFACE - + ds_id = h5pget_virtual_srcspace(dcpl_id, index) hdferr = 0 @@ -7889,9 +7954,9 @@ END SUBROUTINE h5pget_virtual_srcspace_f ! INPUTS ! dcpl_id - The identifier of the virtual dataset creation property list. ! index - Mapping index. -! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), ! where count is the number of mappings returned by h5pget_virtual_count. -! +! ! OUTPUTS ! name - A buffer containing the name of the file containing the source dataset. ! hdferr - Returns 0 if successful and -1 if fails. @@ -7918,10 +7983,10 @@ SUBROUTINE h5pget_virtual_filename_f(dcpl_id, index, name, hdferr, name_len) CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name TYPE(C_PTR) :: f_ptr - + INTERFACE INTEGER(SIZE_T) FUNCTION h5pget_virtual_filename(dcpl_id, index, name, size) BIND(C, NAME='H5Pget_virtual_filename') - IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR + IMPORT :: HID_T, SIZE_T, C_PTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id INTEGER(SIZE_T), INTENT(IN), VALUE :: index @@ -7957,9 +8022,9 @@ END SUBROUTINE h5pget_virtual_filename_f ! INPUTS ! dcpl_id - The identifier of the virtual dataset creation property list. ! index - Mapping index. -! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), +! The value of index is 0 (zero) or greater and less than count (0 ≤ index < count), ! where count is the number of mappings returned by h5pget_virtual_count. -! +! ! OUTPUTS ! name - A buffer containing the name of the source dataset. ! hdferr - Returns 0 if successful and -1 if fails. @@ -7986,10 +8051,10 @@ SUBROUTINE h5pget_virtual_dsetname_f(dcpl_id, index, name, hdferr, name_len) CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name TYPE(C_PTR) :: f_ptr - + INTERFACE INTEGER(SIZE_T) FUNCTION h5pget_virtual_dsetname(dcpl_id, index, name, size) BIND(C, NAME='H5Pget_virtual_dsetname') - IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR + IMPORT :: HID_T, SIZE_T, C_PTR IMPLICIT NONE INTEGER(HID_T) , INTENT(IN), VALUE :: dcpl_id INTEGER(SIZE_T), INTENT(IN), VALUE :: index @@ -8010,13 +8075,193 @@ SUBROUTINE h5pget_virtual_dsetname_f(dcpl_id, index, name, hdferr, name_len) ELSE CALL HD5c2fstring(name,c_name,LEN(name)) ENDIF - ENDIF END SUBROUTINE h5pget_virtual_dsetname_f +!****s* H5P (F03)/h5pget_dset_no_attrs_hint_f_F03 +! +! NAME +! h5pget_dset_no_attrs_hint_f +! +! PURPOSE +! Gets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! dcpl_id - Target dataset creation property list identifier. +! +! OUTPUTS +! minimize - Value of the setting. +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5pget_dset_no_attrs_hint_f(dcpl_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + LOGICAL , INTENT(OUT) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5pget_dset_no_attrs_hint_c(dcpl_id, minimize) BIND(C, NAME='H5Pget_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dcpl_id + LOGICAL(C_BOOL), INTENT(OUT) :: minimize + END FUNCTION h5pget_dset_no_attrs_hint_c + END INTERFACE -END MODULE H5P + hdferr = INT(h5pget_dset_no_attrs_hint_c(dcpl_id, c_minimize)) + ! Transfer value of C C_BOOL type to Fortran LOGICAL + minimize = c_minimize + END SUBROUTINE h5pget_dset_no_attrs_hint_f + +!****s* H5P (F03)/h5pset_dset_no_attrs_hint_f_F03 +! +! NAME +! h5pset_dset_no_attrs_hint_f +! +! PURPOSE +! Sets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! dcpl_id - Target dataset creation property list identifier. +! minimize - Value of the setting. +! +! OUTPUTS +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5pset_dset_no_attrs_hint_f(dcpl_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + LOGICAL , INTENT(IN) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5pset_dset_no_attrs_hint_c(dcpl_id, minimize) BIND(C, NAME='H5Pset_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dcpl_id + LOGICAL(C_BOOL), INTENT(IN), VALUE :: minimize + END FUNCTION h5pset_dset_no_attrs_hint_c + END INTERFACE + + ! Transfer value of Fortran LOGICAL to C C_BOOL type + c_minimize = minimize + + hdferr = INT(h5pset_dset_no_attrs_hint_c(dcpl_id, c_minimize)) + + END SUBROUTINE h5pset_dset_no_attrs_hint_f + +!****s* H5P/H5Pset_vol_f +! +! NAME +! H5Pset_vol_f +! +! PURPOSE +! Set the file VOL connector (VOL_ID) for a file access +! property list (PLIST_ID) +! INPUTS +! plist_id - access property list identifier. +! new_vol_id - VOL connector id. +! +! OUTPUTS +! hdferr - error code: +! 0 on success and -1 on failure +! +! OPTIONAL +! new_vol_info - VOL connector info. +! +! AUTHOR +! M.S. Breitenfeld +! May 2019 +! +! Fortran Interface: + SUBROUTINE h5pset_vol_f(plist_id, new_vol_id, hdferr, new_vol_info) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(HID_T) , INTENT(IN) :: new_vol_id + INTEGER , INTENT(OUT) :: hdferr + TYPE(C_PTR) , OPTIONAL :: new_vol_info +!***** + + TYPE(C_PTR) :: new_vol_info_default + + INTERFACE + INTEGER FUNCTION h5pset_vol(plist_id, new_vol_id, new_vol_info) BIND(C, NAME='H5Pset_vol') + IMPORT :: HID_T, C_PTR + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: plist_id + INTEGER(HID_T), INTENT(IN), VALUE :: new_vol_id + TYPE(C_PTR) , INTENT(IN), VALUE :: new_vol_info + END FUNCTION h5pset_vol + END INTERFACE + + new_vol_info_default = C_NULL_PTR + IF(PRESENT(new_vol_info)) new_vol_info_default=new_vol_info + + hdferr = INT(h5pset_vol(plist_id, new_vol_id, new_vol_info_default)) + + END SUBROUTINE h5pset_vol_f + +!****s* H5P/H5Pget_vol_id_f +! +! NAME +! H5Pget_vol_id_f +! +! PURPOSE +! Get the file VOL connector (VOL_ID) for a file access +! property list (PLIST_ID) +! INPUTS +! plist_id - access property list identifier. +! +! OUTPUTS +! vol_id - VOL connector id. +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! M.S. Breitenfeld +! May 2019 +! +! Fortran Interface: + SUBROUTINE h5pget_vol_id_f(plist_id, vol_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: plist_id + INTEGER(HID_T) , INTENT(OUT) :: vol_id + INTEGER , INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER FUNCTION h5pget_vol_id(plist_id, vol_id) BIND(C, NAME='H5Pget_vol_id') + IMPORT :: HID_T, C_PTR + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: plist_id + INTEGER(HID_T), INTENT(OUT) :: vol_id + END FUNCTION h5pget_vol_id + END INTERFACE + + hdferr = INT(h5pget_vol_id(plist_id, vol_id)) + + END SUBROUTINE h5pget_vol_id_f + +END MODULE H5P diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c index 6a3181f..df2ded4 100644 --- a/fortran/src/H5Rf.c +++ b/fortran/src/H5Rf.c @@ -351,7 +351,7 @@ h5rget_name_ptr_c (hid_t_f *loc_id, int_f *ref_type, void *ref, _fcd name, size_ * OUTPUTS * obj_type - Type of referenced object. These are defined in H5Opublic.h, * enum H5O_type_t - * + * * RETURNS * 0 on success, -1 on failure * AUTHOR diff --git a/fortran/src/H5Rff.F90 b/fortran/src/H5Rff.F90 index 6d6371b..e5cfb1d 100644 --- a/fortran/src/H5Rff.F90 +++ b/fortran/src/H5Rff.F90 @@ -38,7 +38,7 @@ ! !***** -MODULE H5R +MODULE H5R USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_SIGNED_CHAR USE H5GLOBAL @@ -56,13 +56,19 @@ MODULE H5R ! END TYPE ! + PRIVATE h5rget_object_type_obj_f + PRIVATE h5rget_region_region_f, h5rget_region_ptr_f + PRIVATE h5rcreate_object_f, h5rcreate_region_f, h5rcreate_ptr_f + PRIVATE h5rdereference_object_f, h5rdereference_region_f, h5rdereference_ptr_f + PRIVATE h5rget_name_object_f, h5rget_name_region_f, h5rget_name_ptr_f + INTERFACE h5rget_object_type_f MODULE PROCEDURE h5rget_object_type_obj_f END INTERFACE - TYPE :: hdset_reg_ref_t_f03 + TYPE :: hdset_reg_ref_t_f03 INTEGER(C_SIGNED_CHAR), DIMENSION(1:H5R_DSET_REG_REF_BUF_SIZE_F) :: ref END TYPE hdset_reg_ref_t_f03 @@ -165,16 +171,16 @@ CONTAINS ! Retrieves the type of object that an object reference points to. ! ! INPUTS -! dset_id - identifier of the dataset containing +! dset_id - identifier of the dataset containing ! reference to the objects -! ref - reference to open +! ref - reference to open ! OUTPUTS -! obj_type - object_type, possible values: +! obj_type - object_type, possible values: ! H5G_UNKNOWN_F -! H5G_GROUP_F +! H5G_GROUP_F ! H5G_DATASET_F ! H5G_TYPE_F -! hdferr - Returns 0 if successful and -1 if fails +! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR ! Elena Pourmal @@ -227,17 +233,17 @@ CONTAINS ! Retrieves a dataspace with the specified region selected ! ! INPUTS -! dset_id - identifier of the dataset containing +! dset_id - identifier of the dataset containing ! reference to the regions -! ref - reference to open +! ref - reference to open ! OUTPUTS -! space_id - dataspace identifier -! hdferr - Returns 0 if successful and -1 if fails +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails ! AUTHOR ! Elena Pourmal ! August 12, 1999 ! -! HISTORY +! HISTORY ! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). February 28, 2001 @@ -276,16 +282,16 @@ CONTAINS ! h5rget_region_ptr_f ! ! PURPOSE -! Retrieves a dataspace with the specified region +! Retrieves a dataspace with the specified region ! selected using pointer ! ! INPUTS -! dset_id - identifier of the dataset containing +! dset_id - identifier of the dataset containing ! reference to the regions -! ref - reference to open +! ref - reference to open ! OUTPUTS -! space_id - dataspace identifier -! hdferr - Returns 0 if successful and -1 if fails +! space_id - dataspace identifier +! hdferr - Returns 0 if successful and -1 if fails ! AUTHOR ! M. Scot Breitenfeld ! August 4, 2012 @@ -319,7 +325,7 @@ CONTAINS ! loc_id - location identifier ! name - name of the object at the specified location ! Outputs: -! ref - reference to the specified object +! ref - reference to the specified object ! hdferr - returns 0 if successful and -1 if fails ! AUTHOR ! Elena Pourmal @@ -335,7 +341,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rcreate_object_f(loc_id, name, ref, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the object at location specified @@ -363,11 +369,11 @@ CONTAINS ! Creates reference to the dataset region ! ! INPUTS -! loc_id - location identifier -! name - name of the dataset at the specified location -! space_id - dataspace identifier that describes selected region +! loc_id - location identifier +! name - name of the dataset at the specified location +! space_id - dataspace identifier that describes selected region ! OUTPUTS -! ref - reference to the dataset region +! ref - reference to the dataset region ! hdferr - returns 0 if successful and -1 if fails ! AUTHOR ! Elena Pourmal @@ -424,12 +430,12 @@ CONTAINS ! ! Inputs: ! loc_id - location identifier -! name - name of the dataset at the specified location +! name - name of the dataset at the specified location ! ref_type - type of reference: ! H5R_OBJECT ! H5T_STD_REF_DSETREG ! Outputs: -! ref - reference created by the function call. +! ref - reference created by the function call. ! hdferr - returns 0 if successful and -1 if fails. ! OPTIONAL ! space_id - dataspace identifier that describes selected region @@ -444,7 +450,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rcreate_ptr_f(loc_id, name, ref_type, ref, hdferr, space_id) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified @@ -474,7 +480,7 @@ CONTAINS ! Inputs: ! dset_id - identifier of the dataset containing ! reference -! ref - reference to open +! ref - reference to open ! Outputs: ! obj_id - object_identifier ! hdferr - returns 0 if successful and -1 if fails @@ -492,7 +498,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rdereference_object_f(obj_id, ref, ref_obj_id, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id ! Dataset identifier TYPE(hobj_ref_t_f), INTENT(IN), TARGET :: ref ! Object reference @@ -515,8 +521,8 @@ CONTAINS ! ! Inputs: ! dset_id - identifier of the dataset containing -! reference to teh regions -! ref - reference to open +! reference to the regions +! ref - reference to open ! Outputs: ! obj_id - dataspace identifier ! hdferr - returns 0 if successful and -1 if fails @@ -535,7 +541,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rdereference_region_f(obj_id, ref, ref_obj_id, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id ! Dataset identifier TYPE(hdset_reg_ref_t_f), INTENT(IN), TARGET :: ref ! Object reference @@ -576,7 +582,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rdereference_ptr_f(obj_id, ref_type, ref, ref_obj_id, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id ! Valid identifier for the file containing the ! referenced object or any object in that file. @@ -585,7 +591,7 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: ref_obj_id ! Identifier of referenced object INTEGER, INTENT(OUT) :: hdferr ! Error code -!***** +!***** hdferr = h5rdereference_ptr_c(obj_id, ref_type, ref, ref_obj_id) END SUBROUTINE h5rdereference_ptr_f @@ -600,14 +606,14 @@ CONTAINS ! ! Inputs: ! loc_id - Identifier for the file containing the reference or for any object in that file. -! ref - An object or dataset region reference. +! ref - An object or dataset region reference. ! ! Outputs: ! name - A name associated with the referenced object or dataset region. ! hdferr - Returns 0 if successful and -1 if fails. ! ! Optional parameters: -! size - The size of the name buffer, returning 0 (zero) if no name is associated +! size - The size of the name buffer, returning 0 (zero) if no name is associated ! with the identifier. ! ! AUTHOR @@ -616,7 +622,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rget_name_object_f(loc_id, ref, name, hdferr, size) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hobj_ref_t_f), INTENT(IN), TARGET :: ref @@ -648,7 +654,7 @@ CONTAINS ! ! Inputs: ! loc_id - Identifier for the file containing the reference or for any object in that file. -! ref - An object or dataset region reference. +! ref - An object or dataset region reference. ! ! Outputs: ! name - A name associated with the referenced object or dataset region. @@ -663,7 +669,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rget_name_region_f(loc_id, ref, name, hdferr, size) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id TYPE(hdset_reg_ref_t_f), INTENT(IN), TARGET :: ref @@ -712,7 +718,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rget_name_ptr_f(loc_id, ref_type, ref, name, hdferr, size) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER, INTENT(IN) :: ref_type @@ -747,12 +753,12 @@ CONTAINS ! ref - Reference to query. ! ! Outputs: - ! obj_type - Type of referenced object. + ! obj_type - Type of referenced object. ! H5G_UNKNOWN_F ! H5G_GROUP_F ! H5G_DATASET_F ! H5G_TYPE_F - ! + ! ! hdferr - Returns 0 if successful and -1 if fails. ! ! AUTHOR @@ -761,7 +767,7 @@ CONTAINS ! ! Signature: SUBROUTINE h5rget_obj_type_f(loc_id, ref_type, ref, obj_type, hdferr) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id INTEGER, INTENT(IN) :: ref_type diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c index 2eae0d9..e3a5809 100644 --- a/fortran/src/H5Sf.c +++ b/fortran/src/H5Sf.c @@ -994,8 +994,6 @@ done: return ret_value; } - -#ifdef NEW_HYPERSLAB_API /****if* H5Sf/h5scombine_hyperslab_c * NAME * h5scombine_hyperslab_c @@ -1033,22 +1031,21 @@ h5scombine_hyperslab_c ( hid_t_f *space_id , int_f *op, hsize_t_f *start, hsize_ hsize_t *c_block = NULL; H5S_seloper_t c_op; - herr_t status; int rank; int i; rank = H5Sget_simple_extent_ndims(*space_id); if (rank < 0 ) return ret_value; - c_start = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + c_start = (hsize_t *)HDmalloc(sizeof(hsize_t)*(unsigned)rank); if (c_start == NULL) goto DONE; - c_count = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + c_count = (hsize_t *)HDmalloc(sizeof(hsize_t)*(unsigned)rank); if (c_count == NULL) goto DONE; - c_stride = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + c_stride = (hsize_t *)HDmalloc(sizeof(hsize_t)*(unsigned)rank); if (c_stride == NULL) goto DONE; - c_block = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + c_block = (hsize_t *)HDmalloc(sizeof(hsize_t)*(unsigned)rank); if (c_block == NULL) goto DONE; @@ -1119,11 +1116,11 @@ h5scombine_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id, hid_t_ ret_value = 0; return ret_value; } -/****if* H5Sf/h5sselect_select_c +/****if* H5Sf/h5smodify_select_c * NAME - * h5sselect_select_c + * h5smodify_select_c * PURPOSE - * Call H5Sselect_ select + * Call H5Smodify_select * INPUTS * space1_id - identifier of the first dataspace to modify * operator - defines how the new selection is combined @@ -1139,7 +1136,7 @@ h5scombine_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id, hid_t_ */ int_f -h5sselect_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id) +h5smodify_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id) /******/ { int ret_value = -1; @@ -1151,11 +1148,11 @@ h5sselect_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id) c_space1_id = (hid_t)*space1_id; c_space2_id = (hid_t)*space2_id; - if( H5Sselect_select(c_space1_id, c_op, c_space2_id)< 0) return ret_value; + if( H5Smodify_select(c_space1_id, c_op, c_space2_id)< 0) return ret_value; ret_value = 0; return ret_value; } -#endif /*NEW_HYPERSLAB_API*/ + /****if* H5Sf/h5sget_select_type_c * NAME * h5sget_select_type_c @@ -1310,7 +1307,7 @@ h5sdecode_c ( _fcd buf, hid_t_f *obj_id ) */ int_f -h5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) +h5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc, hid_t_f *fapl_id ) /******/ { int ret_value = -1; @@ -1323,7 +1320,7 @@ h5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) if (*nalloc == 0) { - if(H5Sencode((hid_t)*obj_id, c_buf, &c_size) < 0) + if(H5Sencode2((hid_t)*obj_id, c_buf, &c_size, (hid_t)*fapl_id) < 0) return ret_value; *nalloc = (size_t_f)c_size; @@ -1341,7 +1338,7 @@ h5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) /* * Call H5Sencode function. */ - if(H5Sencode((hid_t)*obj_id, c_buf, &c_size) < 0){ + if(H5Sencode2((hid_t)*obj_id, c_buf, &c_size, (hid_t)*fapl_id) < 0){ return ret_value; } diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90 index 3434fba..5199ed6 100644 --- a/fortran/src/H5Sff.F90 +++ b/fortran/src/H5Sff.F90 @@ -49,7 +49,7 @@ CONTAINS ! NAME ! h5screate_simple_f ! -! PURPOSE +! PURPOSE ! Creates a new simple data space and opens it for access . ! ! INPUTS @@ -104,7 +104,7 @@ CONTAINS ENDIF hdferr = h5screate_simple_c(rank, dims, f_maxdims, space_id) DEALLOCATE(f_maxdims) - + END SUBROUTINE h5screate_simple_f ! @@ -142,9 +142,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id END FUNCTION h5sclose_c END INTERFACE - + hdferr = h5sclose_c(space_id) - + END SUBROUTINE h5sclose_f ! @@ -193,9 +193,9 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: space_id END FUNCTION h5screate_c END INTERFACE - + hdferr = h5screate_c(classtype, space_id) - + END SUBROUTINE h5screate_f ! @@ -287,7 +287,7 @@ CONTAINS END INTERFACE hdferr = h5sget_select_hyper_nblocks_c (space_id, num_blocks) - + END SUBROUTINE h5sget_select_hyper_nblocks_f ! @@ -319,7 +319,7 @@ CONTAINS SUBROUTINE h5sget_select_hyper_blocklist_f(space_id, startblock, & num_blocks, buf, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(IN) :: space_id INTEGER(HSIZE_T), INTENT(IN) :: startblock INTEGER(HSIZE_T), INTENT(IN) :: num_blocks INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: buf @@ -432,7 +432,7 @@ CONTAINS END INTERFACE hdferr = h5sget_select_elem_npoints_c (space_id, num_points) - + END SUBROUTINE h5sget_select_elem_npoints_f ! @@ -481,10 +481,10 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: buf END FUNCTION h5sget_select_elem_pointlist_c END INTERFACE - + hdferr = h5sget_select_elem_pointlist_c(space_id, startpoint, & num_points, buf ) - + END SUBROUTINE h5sget_select_elem_pointlist_f ! @@ -500,8 +500,8 @@ CONTAINS ! INPUTS ! space_id - dataspace identifier ! operator - flag, valid values are: -! H5S_SELECT_SET_F -! H5S_SELECT_APPEND_F +! H5S_SELECT_SET_F +! H5S_SELECT_APPEND_F ! H5S_SELECT_PREPEND_F ! rank - number of dataspace dimensions ! num_elements - number of elements to be selected @@ -527,7 +527,7 @@ CONTAINS INTEGER, INTENT(IN) :: rank INTEGER(SIZE_T), INTENT(IN) :: num_elements INTEGER(HSIZE_T), INTENT(IN) , DIMENSION(rank,num_elements) :: coord - INTEGER, INTENT(OUT) :: hdferr + INTEGER, INTENT(OUT) :: hdferr !***** INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:,:) :: c_coord INTEGER :: error, i @@ -595,7 +595,7 @@ CONTAINS SUBROUTINE h5sselect_all_f(space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER, INTENT(OUT) :: hdferr + INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE INTEGER FUNCTION h5sselect_all_c(space_id) BIND(C,NAME='h5sselect_all_c') @@ -604,9 +604,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id END FUNCTION h5sselect_all_c END INTERFACE - + hdferr = h5sselect_all_c(space_id) - + END SUBROUTINE h5sselect_all_f ! @@ -646,9 +646,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id END FUNCTION h5sselect_none_c END INTERFACE - + hdferr = h5sselect_none_c(space_id) - + END SUBROUTINE h5sselect_none_f ! @@ -665,8 +665,8 @@ CONTAINS ! space_id - identifier for the dataspace for which ! selection is verified ! OUTPUTS -! status - TRUE if the selection is contained within -! the extent, FALSE otherwise. +! status - TRUE if the selection is contained within +! the extent, FALSE otherwise. ! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR @@ -695,11 +695,11 @@ CONTAINS INTEGER :: flag END FUNCTION h5sselect_valid_c END INTERFACE - + hdferr = h5sselect_valid_c(space_id, flag) status = .TRUE. IF (flag .EQ. 0) status = .FALSE. - + END SUBROUTINE h5sselect_valid_f ! @@ -729,7 +729,7 @@ CONTAINS ! SOURCE SUBROUTINE h5sget_simple_extent_npoints_f(space_id, npoints, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(IN) :: space_id INTEGER(HSIZE_T), INTENT(OUT) :: npoints INTEGER, INTENT(OUT) :: hdferr !***** @@ -783,7 +783,7 @@ CONTAINS INTEGER(HSSIZE_T), INTENT(OUT) :: npoints END FUNCTION h5sget_select_npoints_c END INTERFACE - + hdferr = h5sget_select_npoints_c(space_id, npoints) END SUBROUTINE h5sget_select_npoints_f @@ -826,9 +826,9 @@ CONTAINS INTEGER, INTENT(OUT) :: rank END FUNCTION h5sget_simple_extent_ndims_c END INTERFACE - + hdferr = h5sget_simple_extent_ndims_c(space_id, rank) - + END SUBROUTINE h5sget_simple_extent_ndims_f ! !****s* H5S/h5sget_simple_extent_dims_f @@ -873,9 +873,9 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: maxdims END FUNCTION h5sget_simple_extent_dims_c END INTERFACE - + hdferr = h5sget_simple_extent_dims_c(space_id, dims, maxdims) - + END SUBROUTINE h5sget_simple_extent_dims_f ! @@ -920,9 +920,9 @@ CONTAINS INTEGER, INTENT(OUT) :: classtype END FUNCTION h5sget_simple_extent_type_c END INTERFACE - + hdferr = h5sget_simple_extent_type_c(space_id, classtype) - + END SUBROUTINE h5sget_simple_extent_type_f ! !****s* H5S/h5sset_extent_simple_f @@ -970,7 +970,7 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(rank), INTENT(IN) :: maximum_size END FUNCTION h5sset_extent_simple_c END INTERFACE - + hdferr = h5sset_extent_simple_c(space_id, rank, current_size, & maximum_size) @@ -1016,11 +1016,11 @@ CONTAINS INTEGER :: flag END FUNCTION h5sis_simple_c END INTERFACE - + hdferr = h5sis_simple_c(space_id, flag) status = .TRUE. IF (flag .EQ. 0) status = .FALSE. - + END SUBROUTINE h5sis_simple_f ! @@ -1156,9 +1156,9 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: space_id END FUNCTION h5sset_extent_none_c END INTERFACE - + hdferr = h5sset_extent_none_c(space_id) - + END SUBROUTINE h5sset_extent_none_f ! !****s* H5S/h5sselect_hyperslab_f @@ -1196,7 +1196,7 @@ CONTAINS SUBROUTINE h5sselect_hyperslab_f(space_id, OPERATOR, start, count, & hdferr, stride, BLOCK) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T), INTENT(IN) :: space_id INTEGER, INTENT(IN) :: OPERATOR INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: start INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: count @@ -1208,7 +1208,7 @@ CONTAINS INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: def_stride INTEGER :: rank INTEGER :: error1, error2 - + INTERFACE INTEGER FUNCTION h5sselect_hyperslab_c(space_id, OPERATOR, & start, count, stride, BLOCK) BIND(C,NAME='h5sselect_hyperslab_c') @@ -1248,7 +1248,7 @@ CONTAINS DEALLOCATE(def_block) RETURN ENDIF - + IF (.NOT.PRESENT(stride).AND. PRESENT(BLOCK)) THEN ALLOCATE(def_stride(rank), stat=error2) IF (error2.NE.0) THEN @@ -1273,7 +1273,7 @@ CONTAINS def_stride, def_block) DEALLOCATE(def_block) DEALLOCATE(def_stride) - + END SUBROUTINE h5sselect_hyperslab_f ! !$! ! !$!****s* H5S/h5scombine_hyperslab_f @@ -1506,7 +1506,7 @@ CONTAINS ! !$!****s* H5S/ ! !$! ! !$! NAME -! !$! h5sselect_select_f +! !$! h5smodify_select_f ! !$! ! !$! PURPOSE ! !$! Refine a hyperslab selection with an operation @@ -1543,7 +1543,7 @@ CONTAINS ! !$! ! ! SOURCE -! SUBROUTINE h5sselect_select_f(space1_id, operator, space2_id, & +! SUBROUTINE h5smodify_select_f(space1_id, operator, space2_id, & ! hdferr) ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(INOUT) :: space1_id ! Dataspace identifier to @@ -1563,22 +1563,22 @@ CONTAINS ! INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTERFACE -! INTEGER FUNCTION h5sselect_select_c(space1_id, operator, & +! INTEGER FUNCTION h5smodify_select_c(space1_id, operator, & ! space2_id) ! USE H5GLOBAL ! !DEC$IF DEFINED(HDF5F90_WINDOWS) -! !DEC$ATTRIBUTES C,reference,decorate,alias:'H5SSELECT_SELECT_C'::h5sselect_select_c +! !DEC$ATTRIBUTES C,reference,decorate,alias:'H5SMODIFY_SELECT_C'::h5smodify_select_c ! !DEC$ENDIF ! INTEGER(HID_T), INTENT(INOUT) :: space1_id ! INTEGER(HID_T), INTENT(IN) :: space2_id ! INTEGER, INTENT(IN) :: operator -! END FUNCTION h5sselect_select_c +! END FUNCTION h5smodify_select_c ! END INTERFACE -! hdferr = h5sselect_select_c(space1_id, operator, space2_id) +! hdferr = h5smodify_select_c(space1_id, operator, space2_id) ! return -! END SUBROUTINE h5sselect_select_f +! END SUBROUTINE h5smodify_select_f ! !****s* H5S/h5sget_select_type_f @@ -1618,10 +1618,10 @@ CONTAINS INTEGER, INTENT(OUT) :: TYPE END FUNCTION h5sget_select_type_c END INTERFACE - + hdferr = h5sget_select_type_c(space_id, TYPE) RETURN - + END SUBROUTINE h5sget_select_type_f ! @@ -1683,25 +1683,32 @@ CONTAINS ! M. Scot Breitenfeld ! March 26, 2008 ! SOURCE - SUBROUTINE h5sencode_f(obj_id, buf, nalloc, hdferr) + SUBROUTINE h5sencode_f(obj_id, buf, nalloc, hdferr, fapl_id) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(LEN=*), INTENT(OUT) :: buf INTEGER(SIZE_T), INTENT(INOUT) :: nalloc INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: fapl_id ! File access property list !***** + INTEGER(HID_T) :: fapl_id_default INTERFACE - INTEGER FUNCTION h5sencode_c(buf, obj_id, nalloc) BIND(C,NAME='h5sencode_c') + INTEGER FUNCTION h5sencode_c(buf, obj_id, nalloc, fapl_id_default) BIND(C,NAME='h5sencode_c') IMPORT :: C_CHAR IMPORT :: HID_T, SIZE_T INTEGER(HID_T), INTENT(IN) :: obj_id CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: buf INTEGER(SIZE_T), INTENT(INOUT) :: nalloc + INTEGER(HID_T) :: fapl_id_default END FUNCTION h5sencode_c END INTERFACE - hdferr = h5sencode_c(buf, obj_id, nalloc) + fapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(fapl_id)) fapl_id_default = fapl_id + + hdferr = h5sencode_c(buf, obj_id, nalloc, fapl_id_default) END SUBROUTINE h5sencode_f @@ -1772,7 +1779,7 @@ CONTAINS ! January, 28 2016 ! SOURCE SUBROUTINE h5sget_regular_hyperslab_f(space_id, start, stride, count, block, hdferr) - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: start @@ -1783,7 +1790,7 @@ CONTAINS !***** TYPE(C_PTR) :: start_c, stride_c, count_c, block_c INTEGER :: n - + INTERFACE INTEGER FUNCTION h5sget_regular_hyperslab(space_id, start, stride, count, block) BIND(C,NAME='H5Sget_regular_hyperslab') IMPORT :: HID_T, C_PTR @@ -1802,7 +1809,7 @@ CONTAINS IF(INT(h5sget_regular_hyperslab(space_id, start_c, stride_c, count_c, block_c)).LT.0) hdferr = -1 - ! Reverse the C arrays description values of the hyperslab because + ! Reverse the C arrays description values of the hyperslab because ! the hyperslab was for a C stored hyperslab CALL H5Sget_simple_extent_ndims_f(space_id,n,hdferr) @@ -1841,8 +1848,8 @@ CONTAINS LOGICAL :: IsRegular INTEGER, INTENT(OUT) :: hdferr !***** - INTEGER(C_INT) :: status - + INTEGER(C_INT) :: status + INTERFACE INTEGER(C_INT) FUNCTION H5Sis_regular_hyperslab(space_id) BIND(C,NAME='H5Sis_regular_hyperslab') IMPORT :: HID_T, C_INT diff --git a/fortran/src/H5Tff.F90 b/fortran/src/H5Tff.F90 index b63c61d..25eb613 100644 --- a/fortran/src/H5Tff.F90 +++ b/fortran/src/H5Tff.F90 @@ -28,7 +28,7 @@ ! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** ! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** ! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| -! +! ! If you add a new function here then you MUST add the function name to the ! Windows dll file 'hdf5_fortrandll.def.in' in the fortran/src directory. ! This is needed for Windows based operating systems. @@ -41,6 +41,8 @@ MODULE H5T USE H5GLOBAL IMPLICIT NONE + PRIVATE h5tenum_insert_f03, h5tenum_insert_f90 + !****t* H5T/hvl_t ! Fortran2003 Derived Type: TYPE hvl_t @@ -90,7 +92,7 @@ CONTAINS ! SOURCE SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr, tapl_id) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(HID_T), INTENT(OUT) :: type_id INTEGER, INTENT(OUT) :: hdferr @@ -229,7 +231,7 @@ CONTAINS ! SOURCE SUBROUTINE h5tcopy_f(type_id, new_type_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: type_id INTEGER(HID_T), INTENT(OUT) :: new_type_id INTEGER, INTENT(OUT) :: hdferr !***** @@ -240,7 +242,7 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: new_type_id END FUNCTION h5tcopy_c END INTERFACE - + hdferr = h5tcopy_c(type_id, new_type_id) END SUBROUTINE h5tcopy_f ! @@ -286,7 +288,7 @@ CONTAINS INTEGER :: c_flag END FUNCTION h5tequal_c END INTERFACE - + flag = .FALSE. hdferr = h5tequal_c(type1_id, type2_id, c_flag) IF(c_flag .GT. 0) flag = .TRUE. @@ -327,7 +329,7 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: type_id END FUNCTION h5tclose_c END INTERFACE - + hdferr = h5tclose_c(type_id) END SUBROUTINE h5tclose_f ! @@ -354,7 +356,7 @@ CONTAINS ! H5T_REFERENCE_F (7) ! H5T_ENUM_F (8) ! H5T_VLEN_F (9) -! H5T_ARRAY_F (10) +! H5T_ARRAY_F (10) ! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR @@ -370,7 +372,7 @@ CONTAINS SUBROUTINE h5tget_class_f(type_id, class, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER, INTENT(OUT) :: class + INTEGER, INTENT(OUT) :: class INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE @@ -423,7 +425,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: size END FUNCTION h5tget_size_c END INTERFACE - + hdferr = h5tget_size_c(type_id, size) END SUBROUTINE h5tget_size_f @@ -467,7 +469,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: size END FUNCTION h5tset_size_c END INTERFACE - + hdferr = h5tset_size_c(type_id, size) END SUBROUTINE h5tset_size_f @@ -517,7 +519,7 @@ CONTAINS INTEGER, INTENT(OUT) :: order END FUNCTION h5tget_order_c END INTERFACE - + hdferr = h5tget_order_c(type_id, order) END SUBROUTINE h5tget_order_f ! @@ -565,7 +567,7 @@ CONTAINS INTEGER, INTENT(IN) :: order END FUNCTION h5tset_order_c END INTERFACE - + hdferr = h5tset_order_c(type_id, order) END SUBROUTINE h5tset_order_f @@ -598,7 +600,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: type_id INTEGER(SIZE_T), INTENT(OUT) :: precision - INTEGER, INTENT(OUT) :: hdferr + INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE INTEGER FUNCTION h5tget_precision_c(type_id, PRECISION) BIND(C,NAME='h5tget_precision_c') @@ -640,7 +642,7 @@ CONTAINS SUBROUTINE h5tset_precision_f(type_id, PRECISION, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER(SIZE_T), INTENT(IN) :: PRECISION + INTEGER(SIZE_T), INTENT(IN) :: PRECISION INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE @@ -651,7 +653,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: PRECISION END FUNCTION h5tset_precision_c END INTERFACE - + hdferr = h5tset_precision_c(type_id, PRECISION) END SUBROUTINE h5tset_precision_f @@ -693,10 +695,10 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: offset END FUNCTION h5tget_offset_c END INTERFACE - + hdferr = h5tget_offset_c(type_id, offset) END SUBROUTINE h5tget_offset_f - + ! !****s* H5T/h5tset_offset_f ! @@ -735,10 +737,10 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: offset END FUNCTION h5tset_offset_c END INTERFACE - + hdferr = h5tset_offset_c(type_id, offset) END SUBROUTINE h5tset_offset_f - + ! !****s* H5T/h5tget_pad_f ! @@ -755,7 +757,7 @@ CONTAINS ! lsbpad - least-significant bit padding type ! msbpad - most-significant bit padding type ! Possible values of padding type are: -! H5T_PAD_ERROR_F +! H5T_PAD_ERROR_F ! H5T_PAD_ZERO_F ! H5T_PAD_ONE_F ! H5T_PAD_BACKGROUND_F @@ -788,7 +790,7 @@ CONTAINS INTEGER, INTENT(OUT) :: msbpad END FUNCTION h5tget_pad_c END INTERFACE - + hdferr = h5tget_pad_c(type_id, lsbpad, msbpad) END SUBROUTINE h5tget_pad_f @@ -839,10 +841,10 @@ CONTAINS INTEGER, INTENT(IN) :: msbpad END FUNCTION h5tset_pad_c END INTERFACE - + hdferr = h5tset_pad_c(type_id, lsbpad, msbpad) END SUBROUTINE h5tset_pad_f - + ! !****s* H5T/h5tget_sign_f ! @@ -857,7 +859,7 @@ CONTAINS ! OUTPUTS ! sign - sign type ! Possible values are: -! - Unsigned integer type +! - Unsigned integer type ! H5T_SGN_NONE_F = 0 ! - Two's complement signed integer type ! H5T_SGN_2_F = 1 @@ -875,7 +877,7 @@ CONTAINS ! SOURCE SUBROUTINE h5tget_sign_f(type_id, sign, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: type_id INTEGER, INTENT(OUT) :: sign INTEGER, INTENT(OUT) :: hdferr !***** @@ -888,10 +890,10 @@ CONTAINS INTEGER, INTENT(OUT) :: sign END FUNCTION h5tget_sign_c END INTERFACE - + hdferr = h5tget_sign_c(type_id, sign) END SUBROUTINE h5tget_sign_f - + ! !****s* H5T/h5tset_sign_f ! @@ -905,7 +907,7 @@ CONTAINS ! type_id - datatype identifier ! sign - sign type ! Possible values are: -! - Unsigned integer type +! - Unsigned integer type ! H5T_SGN_NONE_F = 0 ! - Two's complement signed integer type ! H5T_SGN_2_F = 1 @@ -936,7 +938,7 @@ CONTAINS INTEGER, INTENT(IN) :: sign END FUNCTION h5tset_sign_c END INTERFACE - + hdferr = h5tset_sign_c(type_id, sign) END SUBROUTINE h5tset_sign_f @@ -992,7 +994,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: msize END FUNCTION h5tget_fields_c END INTERFACE - + hdferr = h5tget_fields_c(type_id, spos, epos, esize, mpos, msize) END SUBROUTINE h5tget_fields_f @@ -1026,7 +1028,7 @@ CONTAINS ! SOURCE SUBROUTINE h5tset_fields_f(type_id, spos, epos, esize, mpos, msize, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: type_id INTEGER(SIZE_T), INTENT(IN) :: spos INTEGER(SIZE_T), INTENT(IN) :: epos INTEGER(SIZE_T), INTENT(IN) :: esize @@ -1048,10 +1050,10 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: msize END FUNCTION h5tset_fields_c END INTERFACE - + hdferr = h5tset_fields_c(type_id, spos, epos, esize, mpos, msize) END SUBROUTINE h5tset_fields_f - + ! !****s* H5T/h5tget_ebias_f ! @@ -1082,7 +1084,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: ebias INTEGER, INTENT(OUT) :: hdferr !***** - + INTERFACE INTEGER FUNCTION h5tget_ebias_c(type_id, ebias) BIND(C,NAME='h5tget_ebias_c') IMPORT :: HID_T, SIZE_T @@ -1091,7 +1093,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: ebias END FUNCTION h5tget_ebias_c END INTERFACE - + hdferr = h5tget_ebias_c(type_id, ebias) END SUBROUTINE h5tget_ebias_f @@ -1133,7 +1135,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(IN) :: ebias END FUNCTION h5tset_ebias_c END INTERFACE - + hdferr = h5tset_ebias_c(type_id, ebias) END SUBROUTINE h5tset_ebias_f @@ -1180,7 +1182,7 @@ CONTAINS INTEGER, INTENT(OUT) :: norm END FUNCTION h5tget_norm_c END INTERFACE - + hdferr = h5tget_norm_c(type_id, norm) END SUBROUTINE h5tget_norm_f @@ -1226,7 +1228,7 @@ CONTAINS INTEGER, INTENT(IN) :: norm END FUNCTION h5tset_norm_c END INTERFACE - + hdferr = h5tset_norm_c(type_id, norm) END SUBROUTINE h5tset_norm_f @@ -1273,7 +1275,7 @@ CONTAINS INTEGER, INTENT(OUT) :: padtype END FUNCTION h5tget_inpad_c END INTERFACE - + hdferr = h5tget_inpad_c(type_id, padtype) END SUBROUTINE h5tget_inpad_f @@ -1319,7 +1321,7 @@ CONTAINS INTEGER, INTENT(IN) :: padtype END FUNCTION h5tset_inpad_c END INTERFACE - + hdferr = h5tset_inpad_c(type_id, padtype) END SUBROUTINE h5tset_inpad_f @@ -1364,7 +1366,7 @@ CONTAINS INTEGER, INTENT(OUT) :: cset END FUNCTION h5tget_cset_c END INTERFACE - + hdferr = h5tget_cset_c(type_id, cset) END SUBROUTINE h5tget_cset_f @@ -1409,7 +1411,7 @@ CONTAINS INTEGER, INTENT(IN) :: cset END FUNCTION h5tset_cset_c END INTERFACE - + hdferr = h5tset_cset_c(type_id, cset) END SUBROUTINE h5tset_cset_f ! @@ -1455,7 +1457,7 @@ CONTAINS INTEGER, INTENT(OUT) :: strpad END FUNCTION h5tget_strpad_c END INTERFACE - + hdferr = h5tget_strpad_c(type_id, strpad) END SUBROUTINE h5tget_strpad_f @@ -1545,7 +1547,7 @@ CONTAINS INTEGER, INTENT(OUT) :: num_members END FUNCTION h5tget_nmembers_c END INTERFACE - + hdferr = h5tget_nmembers_c(type_id, num_members) END SUBROUTINE h5tget_nmembers_f @@ -1594,7 +1596,7 @@ CONTAINS INTEGER, INTENT(OUT) :: namelen END FUNCTION h5tget_member_name_c END INTERFACE - + hdferr = h5tget_member_name_c(type_id, index, member_name, namelen) END SUBROUTINE h5tget_member_name_f @@ -1639,7 +1641,7 @@ CONTAINS INTEGER(SIZE_T), INTENT(OUT) :: offset END FUNCTION h5tget_member_offset_c END INTERFACE - + hdferr = h5tget_member_offset_c(type_id, member_no, offset ) END SUBROUTINE h5tget_member_offset_f ! @@ -1684,11 +1686,11 @@ CONTAINS INTEGER, INTENT(OUT) :: index END FUNCTION h5tget_member_index_c END INTERFACE - + namelen = LEN(name) hdferr = h5tget_member_index_c(type_id, name, namelen, index) END SUBROUTINE h5tget_member_index_f - + ! !$! ! !$!****s* H5T/h5tget_member_dim_f @@ -1772,9 +1774,9 @@ CONTAINS INTEGER(HSIZE_T),DIMENSION(*), INTENT(OUT) :: dims END FUNCTION h5tget_array_dims_c END INTERFACE - + hdferr = h5tget_array_dims_c(type_id, dims) - + END SUBROUTINE h5tget_array_dims_f ! @@ -1815,9 +1817,9 @@ CONTAINS INTEGER, INTENT(OUT) :: ndims END FUNCTION h5tget_array_ndims_c END INTERFACE - + hdferr = h5tget_array_ndims_c(type_id, ndims) - + END SUBROUTINE h5tget_array_ndims_f ! @@ -1858,9 +1860,9 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: base_type_id END FUNCTION h5tget_super_c END INTERFACE - + hdferr = h5tget_super_c(type_id, base_type_id) - + END SUBROUTINE h5tget_super_f ! @@ -1906,7 +1908,7 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: datatype END FUNCTION h5tget_member_type_c END INTERFACE - + hdferr = h5tget_member_type_c(type_id, field_idx , datatype) END SUBROUTINE h5tget_member_type_f @@ -1990,7 +1992,7 @@ CONTAINS SUBROUTINE h5tinsert_f(type_id, name, offset, field_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: type_id - CHARACTER(LEN=*), INTENT(IN) :: name + CHARACTER(LEN=*), INTENT(IN) :: name INTEGER(SIZE_T), INTENT(IN) :: offset INTEGER(HID_T), INTENT(IN) :: field_id INTEGER, INTENT(OUT) :: hdferr @@ -2009,11 +2011,11 @@ CONTAINS INTEGER :: namelen END FUNCTION h5tinsert_c END INTERFACE - + namelen = LEN(name) hdferr = h5tinsert_c(type_id, name, namelen, offset, field_id ) END SUBROUTINE h5tinsert_f - + ! !****s* H5T/h5tpack_f ! @@ -2049,10 +2051,10 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: type_id END FUNCTION h5tpack_c END INTERFACE - + hdferr = h5tpack_c(type_id) END SUBROUTINE h5tpack_f - + ! !$! ! !$!****s* H5T/h5tinsert_array_f ! !$! @@ -2148,9 +2150,9 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: type_id END FUNCTION h5tarray_create_c END INTERFACE - + hdferr = h5tarray_create_c(base_id, rank, dims, type_id) - + END SUBROUTINE h5tarray_create_f ! @@ -2192,7 +2194,7 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: new_type_id END FUNCTION h5tenum_create_c END INTERFACE - + hdferr = h5tenum_create_c(parent_id, new_type_id) END SUBROUTINE h5tenum_create_f ! @@ -2223,9 +2225,9 @@ CONTAINS ! port). March 7, 2001 ! ! NOTE -! According to the standard: Because an INTENT(OUT) variable is considered undefined -! on entry to the procedure, any default initialization specified for its type will -! be applied. So we need to blank out the "name" to be portable and eliminate any +! According to the standard: Because an INTENT(OUT) variable is considered undefined +! on entry to the procedure, any default initialization specified for its type will +! be applied. So we need to blank out the "name" to be portable and eliminate any ! characters the "name' may contain upon entry, depending on compiler implementation. ! SOURCE SUBROUTINE h5tenum_nameof_f(type_id, value, namelen, name, hdferr) @@ -2247,7 +2249,7 @@ CONTAINS INTEGER, INTENT(IN) :: value END FUNCTION h5tenum_nameof_c END INTERFACE - + name(1:LEN(name)) = ' ' hdferr = h5tenum_nameof_c(type_id, value, name, namelen) @@ -2300,7 +2302,7 @@ CONTAINS INTEGER, INTENT(OUT) :: value END FUNCTION h5tenum_valueof_c END INTERFACE - + namelen = LEN(name) hdferr = h5tenum_valueof_c(type_id, name, namelen, value) END SUBROUTINE h5tenum_valueof_f @@ -2347,10 +2349,10 @@ CONTAINS INTEGER, INTENT(OUT) :: value END FUNCTION h5tget_member_value_c END INTERFACE - + hdferr = h5tget_member_value_c(type_id, member_no, value) END SUBROUTINE h5tget_member_value_f - + ! !****s* H5T/h5tset_tag_f ! @@ -2383,7 +2385,7 @@ CONTAINS INTEGER, INTENT(OUT) :: hdferr !***** INTEGER :: taglen - + INTERFACE INTEGER FUNCTION h5tset_tag_c(type_id, tag, taglen) BIND(C,NAME='h5tset_tag_c') IMPORT :: C_CHAR @@ -2394,11 +2396,11 @@ CONTAINS INTEGER :: taglen END FUNCTION h5tset_tag_c END INTERFACE - + taglen = LEN(tag) hdferr = h5tset_tag_c(type_id, tag, taglen) END SUBROUTINE h5tset_tag_f - + ! !****s* H5T/h5tget_tag_f ! @@ -2432,7 +2434,7 @@ CONTAINS INTEGER, INTENT(OUT) :: taglen INTEGER, INTENT(OUT) :: hdferr !***** - INTEGER(SIZE_T):: tag_size ! Declared character length of tab + INTEGER(SIZE_T):: tag_size ! Declared character length of tab INTERFACE INTEGER FUNCTION h5tget_tag_c(type_id, tag, tag_size, taglen) & BIND(C,NAME='h5tget_tag_c') @@ -2445,11 +2447,11 @@ CONTAINS INTEGER, INTENT(OUT) :: taglen END FUNCTION h5tget_tag_c END INTERFACE - + tag_size = LEN(tag) hdferr = h5tget_tag_c(type_id, tag, tag_size, taglen ) END SUBROUTINE h5tget_tag_f - + ! !****s* H5T/h5tvlen_create_f ! @@ -2487,7 +2489,7 @@ CONTAINS INTEGER(HID_T), INTENT(OUT) :: vltype_id END FUNCTION h5tvlen_create_c END INTERFACE - + hdferr = h5tvlen_create_c(type_id, vltype_id) END SUBROUTINE h5tvlen_create_f @@ -2515,11 +2517,11 @@ CONTAINS SUBROUTINE h5tis_variable_str_f(type_id, status, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: type_id - LOGICAL, INTENT(OUT) :: status + LOGICAL, INTENT(OUT) :: status INTEGER, INTENT(OUT) :: hdferr !***** INTEGER :: flag ! "TRUE/FALSE/ERROR from C" - + INTERFACE INTEGER FUNCTION h5tis_variable_str_c(type_id, flag) & BIND(C,NAME='h5tis_variable_str_c') @@ -2529,13 +2531,13 @@ CONTAINS INTEGER :: flag END FUNCTION h5tis_variable_str_c END INTERFACE - + hdferr = h5tis_variable_str_c(type_id, flag) status = .TRUE. IF (flag .EQ. 0) status = .FALSE. - + END SUBROUTINE h5tis_variable_str_f - + ! !****s* H5T/h5tget_member_class_f ! @@ -2726,7 +2728,7 @@ CONTAINS SUBROUTINE h5tdecode_f(buf, obj_id, hdferr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: buf - INTEGER(HID_T), INTENT(OUT) :: obj_id + INTEGER(HID_T), INTENT(OUT) :: obj_id INTEGER, INTENT(OUT) :: hdferr !***** INTERFACE @@ -2809,7 +2811,7 @@ CONTAINS ! SOURCE SUBROUTINE h5tget_create_plist_f(dtype_id, dtpl_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dtype_id + INTEGER(HID_T), INTENT(IN) :: dtype_id INTEGER(HID_T), INTENT(OUT) :: dtpl_id INTEGER, INTENT(OUT) :: hdferr !***** @@ -2882,7 +2884,7 @@ CONTAINS ! ! INPUTS ! dtype_id - Datatype identifier for the dataset datatype. -! +! ! direction - Direction of search: ! H5T_DIR_DEFAULT, default direction is inscendent, ! H5T_DIR_ASCEND , in inscendent order, @@ -2899,8 +2901,8 @@ CONTAINS ! SOURCE SUBROUTINE h5tget_native_type_f(dtype_id, direction, native_dtype_id, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: dtype_id - INTEGER, INTENT(IN) :: direction + INTEGER(HID_T), INTENT(IN) :: dtype_id + INTEGER, INTENT(IN) :: direction INTEGER(HID_T), INTENT(OUT) :: native_dtype_id INTEGER, INTENT(OUT) :: hdferr !***** @@ -3023,7 +3025,7 @@ CONTAINS INTEGER :: namelen END FUNCTION h5tenum_insert_c END INTERFACE - + namelen = LEN(name) hdferr = h5tenum_insert_c(type_id, name, namelen, value) END SUBROUTINE h5tenum_insert_f90 @@ -3059,7 +3061,7 @@ CONTAINS INTEGER, INTENT(OUT) :: hdferr !***** INTEGER :: namelen - + INTERFACE INTEGER FUNCTION h5tenum_insert_ptr_c(type_id, name, namelen, value) & BIND(C, NAME='h5tenum_insert_ptr_c') @@ -3072,7 +3074,7 @@ CONTAINS TYPE(C_PTR), VALUE :: value END FUNCTION h5tenum_insert_ptr_c END INTERFACE - + namelen = LEN(name) hdferr = h5tenum_insert_ptr_c(type_id, name, namelen, value) END SUBROUTINE h5tenum_insert_f03 diff --git a/fortran/src/H5VLff.F90 b/fortran/src/H5VLff.F90 new file mode 100644 index 0000000..ae03cee --- /dev/null +++ b/fortran/src/H5VLff.F90 @@ -0,0 +1,437 @@ +!****h* ROBODoc/H5VL +! +! NAME +! MODULE H5VL +! +! PURPOSE +! This file contains Fortran interfaces for H5VL (VOL) functions. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the COPYING file, which can be found at the root of the source code * +! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * +! If you do not have access to either file, you may request a copy from * +! help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! NOTES +! _____ __ __ _____ ____ _____ _______ _ _ _______ +! |_ _| \/ | __ \ / __ \| __ \__ __|/\ | \ | |__ __| +! **** | | | \ / | |__) | | | | |__) | | | / \ | \| | | | **** +! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** +! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** +! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| +! +! If you add a new H5VL function you must add the function name to the +! Windows dll file 'hdf5_fortrandll.def.in' in the fortran/src directory. +! This is needed for Windows based operating systems. +! +!***** + +MODULE H5VL + + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR, C_CHAR, C_INT64_T, C_INT + USE H5GLOBAL + USE H5fortkit + + IMPLICIT NONE + +CONTAINS + +! H5VLregister_connector + +! +!****s* H5VL/H5VLregister_connector_by_name_f +! +! NAME +! H5VLregister_connector_by_name_f +! +! PURPOSE +! Registers a new VOL connector as a member of the virtual object +! layer class by name. +! +! INPUTS +! name - Connector name +! OUTPUTS +! vol_id - VOL id +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLregister_connector_by_name_f(name, vol_id, hdferr, vipl_id) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(OUT) :: vol_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: vipl_id +!***** + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + INTEGER(HID_T) :: vipl_id_default + + INTERFACE + INTEGER(HID_T) FUNCTION H5VLregister_connector_by_name(name, vipl_id) & + BIND(C,NAME='H5VLregister_connector_by_name') + IMPORT :: C_CHAR + IMPORT :: HID_T + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(IN), VALUE :: vipl_id + END FUNCTION H5VLregister_connector_by_name + END INTERFACE + + vipl_id_default = H5P_DEFAULT_F + IF(PRESENT(vipl_id)) vipl_id_default = vipl_id + + c_name = TRIM(name)//C_NULL_CHAR + vol_id = H5VLregister_connector_by_name(c_name, vipl_id_default) + + hdferr = 0 + IF(vol_id.LT.0) hdferr = H5I_INVALID_HID_F + + END SUBROUTINE H5VLregister_connector_by_name_f + + SUBROUTINE H5VLregister_connector_by_value_f(connector_value, vol_id, hdferr, vipl_id) + IMPLICIT NONE + INTEGER, INTENT(IN) :: connector_value + INTEGER(HID_T), INTENT(OUT) :: vol_id + INTEGER, INTENT(OUT) :: hdferr + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: vipl_id +!***** + INTEGER(HID_T) :: vipl_id_default + + INTERFACE + INTEGER(HID_T) FUNCTION H5VLregister_connector_by_value(connector_value, vipl_id) & + BIND(C,NAME='H5VLregister_connector_by_value') + IMPORT :: HID_T + IMPORT :: C_INT + INTEGER(C_INT), VALUE :: connector_value + INTEGER(HID_T), INTENT(IN), VALUE :: vipl_id + END FUNCTION H5VLregister_connector_by_value + END INTERFACE + + vipl_id_default = H5P_DEFAULT_F + IF(PRESENT(vipl_id)) vipl_id_default = vipl_id + + vol_id = H5VLregister_connector_by_value(INT(connector_value,C_INT), vipl_id_default) + + hdferr = 0 + IF(vol_id.LT.0) hdferr = H5I_INVALID_HID_F + + END SUBROUTINE H5VLregister_connector_by_value_f + +! +!****s* H5VL/H5VLis_connector_registered_by_name_f +! +! NAME +! H5VLis_connector_registered_by_name_f +! +! PURPOSE +! Tests whether a VOL class has been registered or not +! according to a specified connector name. +! +! INPUTS +! name - Connector name +! OUTPUTS +! registered - state of VOL class registration +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLis_connector_registered_by_name_f(name, registered, hdferr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + LOGICAL, INTENT(OUT) :: registered + INTEGER, INTENT(OUT) :: hdferr +!***** + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + INTEGER(C_INT) :: registered_c + + INTERFACE + INTEGER(C_INT) FUNCTION H5VLis_connector_registered_by_name(name) BIND(C,NAME='H5VLis_connector_registered_by_name') + IMPORT :: C_CHAR + IMPORT :: C_INT + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + END FUNCTION H5VLis_connector_registered_by_name + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + registered_c = H5VLis_connector_registered_by_name(c_name) + + hdferr = 0 + registered = .FALSE. + IF(registered_c .GT. 0) registered = .TRUE. + IF(registered_c .LT. 0) hdferr = INT(registered_c) + + END SUBROUTINE H5VLis_connector_registered_by_name_f + +! +!****s* H5VL/H5VLis_connector_registered_by_value_f +! +! NAME +! H5VLis_connector_registered_by_value_f +! +! PURPOSE +! Tests whether a VOL class has been registered or not +! according to a specified connector value (ID). +! +! INPUTS +! value - Connector value +! OUTPUTS +! registered - state of VOL class registration +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLis_connector_registered_by_value_f(value, registered, hdferr) + IMPLICIT NONE + INTEGER, INTENT(IN) :: value + LOGICAL, INTENT(OUT) :: registered + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER(C_INT) :: registered_c + + INTERFACE + INTEGER(C_INT) FUNCTION H5VLis_connector_registered_by_value(value) BIND(C,NAME='H5VLis_connector_registered_by_value') + IMPORT :: C_INT + INTEGER(C_INT), VALUE :: value + END FUNCTION H5VLis_connector_registered_by_value + END INTERFACE + + registered_c = H5VLis_connector_registered_by_value(INT(value,C_INT)) + + hdferr = 0 + registered = .FALSE. + IF(registered_c .GT. 0) registered = .TRUE. + IF(registered_c .LT. 0) hdferr = INT(registered_c) + + END SUBROUTINE H5VLis_connector_registered_by_value_f + +! +!****s* H5VL/H5VLget_connector_id_f +! +! NAME +! H5VLget_connector_id_f +! +! PURPOSE +! Retrieves the ID for a registered VOL connector. +! +! INPUTS +! obj_id - Object id +! OUTPUTS +! vol_id - Connector id +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLget_connector_id_f(obj_id, vol_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER(HID_T), INTENT(OUT) :: vol_id + INTEGER, INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER(HID_T) FUNCTION H5VLget_connector_id(obj_id) BIND(C,NAME='H5VLget_connector_id') + IMPORT :: HID_T + INTEGER(HID_T), INTENT(IN) :: obj_id + END FUNCTION H5VLget_connector_id + END INTERFACE + + vol_id = H5VLget_connector_id(obj_id) + + IF(vol_id.LT.0)THEN + hdferr = -1 + vol_id = H5I_INVALID_HID_F + ENDIF + + END SUBROUTINE H5VLget_connector_id_f + +! +!****s* H5VL/H5VLget_connector_id_by_name_f +! +! NAME +! H5VLget_connector_id_by_name_f +! +! PURPOSE +! Retrieves the ID for a registered VOL connector. +! +! INPUTS +! name - Connector name +! OUTPUTS +! vol_id - Connector id +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLget_connector_id_by_name_f(name, vol_id, hdferr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T), INTENT(OUT) :: vol_id + INTEGER, INTENT(OUT) :: hdferr +!***** + CHARACTER(LEN=LEN_TRIM(name)+1,KIND=C_CHAR) :: c_name + + INTERFACE + INTEGER(HID_T) FUNCTION H5VLget_connector_id_by_name(name) BIND(C,NAME='H5VLget_connector_id_by_name') + IMPORT :: C_CHAR + IMPORT :: HID_T + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + END FUNCTION H5VLget_connector_id_by_name + END INTERFACE + + c_name = TRIM(name)//C_NULL_CHAR + vol_id = H5VLget_connector_id_by_name(c_name) + + hdferr = 0 + IF(vol_id.LT.0)THEN + hdferr = -1 + vol_id = H5I_INVALID_HID_F + ENDIF + + END SUBROUTINE H5VLget_connector_id_by_name_f + +! +!****s* H5VL/H5VLget_connector_id_by_value_f +! +! NAME +! H5VLget_connector_id_by_value_f +! +! PURPOSE +! Retrieves the ID for a registered VOL connector. +! +! INPUTS +! value - Connector value +! OUTPUTS +! vol_id - Connector id +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLget_connector_id_by_value_f(value, vol_id, hdferr) + IMPLICIT NONE + INTEGER, INTENT(IN) :: value + INTEGER(HID_T), INTENT(OUT) :: vol_id + INTEGER, INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER(HID_T) FUNCTION H5VLget_connector_id_by_value(value) BIND(C,NAME='H5VLget_connector_id_by_value') + IMPORT :: C_INT + IMPORT :: HID_T + INTEGER(C_INT), VALUE :: value + END FUNCTION H5VLget_connector_id_by_value + END INTERFACE + + vol_id = H5VLget_connector_id_by_value(INT(value,C_INT)) + + hdferr = 0 + IF(vol_id.LT.0)THEN + hdferr = -1 + vol_id = H5I_INVALID_HID_F + ENDIF + + END SUBROUTINE H5VLget_connector_id_by_value_f + + SUBROUTINE H5VLget_connector_name_f(obj_id, name, hdferr, name_len) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER, INTENT(OUT) :: hdferr + INTEGER(SIZE_T), OPTIONAL :: name_len +!***** + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name + INTEGER(SIZE_T) :: l + + INTERFACE + INTEGER(SIZE_T) FUNCTION H5VLget_connector_name(obj_id, name, size) BIND(C,NAME='H5VLget_connector_name') + IMPORT :: HID_T, SIZE_T, C_PTR, C_CHAR + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN), VALUE :: obj_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name + ! TYPE(C_PTR), value :: name + INTEGER(SIZE_T), INTENT(IN), VALUE :: size + END FUNCTION H5VLget_connector_name + END INTERFACE + + hdferr = 0 + IF(PRESENT(name_len))THEN + c_name(1:1)(1:1) = C_NULL_CHAR + name_len = INT(H5VLget_connector_name(obj_id, c_name, 1_SIZE_T), SIZE_T) + IF(name_len.LT.0) hdferr = H5I_INVALID_HID_F + ELSE + l = INT(LEN(name)+1,SIZE_T) + IF(INT(H5VLget_connector_name(obj_id, c_name, l), SIZE_T).LT.0)THEN + hdferr = H5I_INVALID_HID_F + ELSE + CALL HD5c2fstring(name,c_name,LEN(name)) + ENDIF + ENDIF + + END SUBROUTINE H5VLget_connector_name_f + +! +! +!****s* H5VL/H5VLclose_f +! +! NAME +! H5VLclose_f +! +! PURPOSE +! Closes a VOL connector ID. +! +! INPUTS +! vol_id - A valid identifier of the connectory to unregister. +! +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLclose_f(vol_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: vol_id + INTEGER, INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER FUNCTION H5VLclose(vol_id) BIND(C, NAME='H5VLclose') + IMPORT :: HID_T + INTEGER(HID_T), INTENT(IN), VALUE :: vol_id + END FUNCTION H5VLclose + END INTERFACE + + hdferr = INT(H5VLclose(vol_id)) + + END SUBROUTINE H5VLclose_f + +! +!****s* H5VL/H5VLunregister_connector_f +! +! NAME +! H5VLunregister_connector_f +! +! PURPOSE +! Removes a VOL connector ID from the library. +! +! INPUTS +! plugin_id - A valid identifier of the connector to unregister. +! +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! SOURCE + + SUBROUTINE H5VLunregister_connector_f(plugin_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plugin_id + INTEGER, INTENT(OUT) :: hdferr +!***** + + INTERFACE + INTEGER FUNCTION H5VLunregister_connector(plugin_id) BIND(C, NAME='H5VLunregister_connector') + IMPORT :: HID_T + INTEGER(HID_T), INTENT(IN), VALUE :: plugin_id + END FUNCTION H5VLunregister_connector + END INTERFACE + + hdferr = INT(H5VLunregister_connector(plugin_id)) + + END SUBROUTINE H5VLunregister_connector_f + +END MODULE H5VL diff --git a/fortran/src/H5Zff.F90 b/fortran/src/H5Zff.F90 index 848f047..6bd7b45 100644 --- a/fortran/src/H5Zff.F90 +++ b/fortran/src/H5Zff.F90 @@ -56,7 +56,7 @@ CONTAINS ! H5Z_FILTER_SCALEOFFSET_F ! H5Z_FILTER_SHUFFLE_F ! H5Z_FILTER_FLETCHER32_F -! +! ! OUTPUTS ! hdferr - Error code ! Success: 0 @@ -147,7 +147,7 @@ CONTAINS ! H5Z_FILTER_SHUFFLE_F ! H5Z_FILTER_FLETCHER32_Ffilter ! OUTPUTS -! config_flags - Flag, indicates if filter has its encoder +! config_flags - Flag, indicates if filter has its encoder ! and/or decoder available, possibly containing the ! following values: ! H5Z_FILTER_ENCODE_ENABLED_F diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index d4ebdd3..e81e1c0 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -13,8 +13,8 @@ ! depending on which of the KIND values are found. ! ! NOTES -! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF -! depending on availablity.It generates code that makes use of +! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF +! depending on availablity.It generates code that makes use of ! STORAGE_SIZE/SIZEOF in H5_gen.F90. STORAGE_SIZE is standard ! compliant and should always be chosen over SIZEOF. ! @@ -47,7 +47,7 @@ #include <H5config_f.inc> PROGRAM H5_buildiface - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_LOC IMPLICIT NONE ! These values are valid REAL KINDs (with corresponding C float) found during configure @@ -98,7 +98,7 @@ PROGRAM H5_buildiface ! ! DEVELOPER'S NOTES: ! -! Only interfaces with arrays of rank 7 and less are provided. Even-though, the F2008 +! Only interfaces with arrays of rank 7 and less are provided. Even-though, the F2008 ! standard extended the maximum rank to 15, it was decided that user's should use the ! new APIs to handle those use cases. Handling rank 7 and less is for backward compatibility ! with the Fortran 90/95 APIs codes which could never handle ranks greater than 7. @@ -135,162 +135,268 @@ PROGRAM H5_buildiface WRITE(11,'(A)') "MODULE H5_GEN" - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' - WRITE(11,'(A)') ' USE H5GLOBAL' + WRITE(11,'(2X,A)') 'USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_LOC' + WRITE(11,'(2X,A)') 'USE H5GLOBAL' + + WRITE(11,'(2X,A)') 'USE H5A' + WRITE(11,'(2X,A)') 'USE H5D' + WRITE(11,'(2X,A)') 'USE H5P' + WRITE(11,'(2X,A)') 'IMPLICIT NONE' + +!****************************** +! DECLARE PRIVATE INTERFACES +!****************************** + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_ckind_rank"//chr_rank(k) + ENDDO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_ckind_rank"//chr_rank(k) + ENDDO + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_ckind_rank"//chr_rank(k) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_ckind_rank"//chr_rank(k) + ENDDO + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pset_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pget_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) + END DO - WRITE(11,'(A)') ' USE H5A' - WRITE(11,'(A)') ' USE H5D' - WRITE(11,'(A)') ' USE H5P' - WRITE(11,'(A)') ' IMPLICIT NONE' !*************** ! H5A INTERFACES !*************** ! ! H5Awrite_f ! - WRITE(11,'(A)') " INTERFACE h5awrite_f" + WRITE(11,'(2X,A)') "INTERFACE h5awrite_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Aread_f - WRITE(11,'(A)') " INTERFACE h5aread_f" + WRITE(11,'(2X,A)') "INTERFACE h5aread_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" !*************** ! H5D INTERFACES !*************** ! ! H5Dwrite_f - WRITE(11,'(A)') " INTERFACE h5dwrite_f" + WRITE(11,'(2X,A)') "INTERFACE h5dwrite_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO - END DO + END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_ckind_rank"//chr_rank(k) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Dread_f - WRITE(11,'(A)') " INTERFACE h5dread_f" + WRITE(11,'(2X,A)') "INTERFACE h5dread_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) - ENDDO + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" !*************** ! H5P INTERFACES !*************** ! ! H5Pset_fill_value_f - WRITE(11,'(A)') " INTERFACE h5pset_fill_value_f" + WRITE(11,'(2X,A)') "INTERFACE h5pset_fill_value_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pget_fill_value_f - WRITE(11,'(A)') " INTERFACE h5pget_fill_value_f" + WRITE(11,'(2X,A)') "INTERFACE h5pget_fill_value_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pset_f - WRITE(11,'(A)') " INTERFACE h5pset_f" + WRITE(11,'(2X,A)') "INTERFACE h5pset_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pget_f - WRITE(11,'(A)') " INTERFACE h5pget_f" + WRITE(11,'(2X,A)') "INTERFACE h5pget_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pregister_f - WRITE(11,'(A)') " INTERFACE h5pregister_f" + WRITE(11,'(2X,A)') "INTERFACE h5pregister_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pinsert_f - WRITE(11,'(A)') " INTERFACE h5pinsert_f" + WRITE(11,'(2X,A)') "INTERFACE h5pinsert_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" WRITE(11,'(A)') 'CONTAINS' @@ -342,7 +448,7 @@ PROGRAM H5_buildiface ! up to 7 dimensions. ! ! Fortran90 Interface: -!! SUBROUTINE H5Awrite_f(attr_id, memtype_id, buf, dims, hdferr) +!! SUBROUTINE H5Awrite_f(attr_id, memtype_id, buf, dims, hdferr) !! INTEGER(HID_T) , INTENT(IN) :: attr_id !! INTEGER(HID_T) , INTENT(IN) :: memtype_id !! TYPE , INTENT(IN) :: buf @@ -370,7 +476,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Awrite_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5awrite_rkind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j) @@ -396,7 +502,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Awrite_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5awrite_ikind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j) @@ -418,7 +524,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' CHARACTER(LEN=*) , INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') fchr_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Awrite_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5awrite_ckind_rank'//chr_rank(j) @@ -468,7 +574,7 @@ PROGRAM H5_buildiface ! REAL, REAL(KIND=C_DOUBLE) and CHARACTER buffers ! up to 7 dimensions. ! Fortran90 Interface: -!! SUBROUTINE H5Aread_f(attr_id, memtype_id, buf, dims, hdferr) +!! SUBROUTINE H5Aread_f(attr_id, memtype_id, buf, dims, hdferr) !! INTEGER(HID_T) , INTENT(IN) :: attr_id !! INTEGER(HID_T) , INTENT(IN) :: memtype_id !! TYPE , INTENT(INOUT) :: buf @@ -493,7 +599,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Aread_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5aread_rkind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j) @@ -517,7 +623,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(INOUT)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') f_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Aread_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5aread_ikind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j) @@ -537,7 +643,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf' WRITE(11,'(A)') ' INTEGER , INTENT(OUT) :: hdferr' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr' - + WRITE(11,'(A)') fchr_ptr_line(j) WRITE(11,'(A)') ' hdferr = H5Aread_f_c(attr_id, memtype_id, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5aread_ckind_rank'//chr_rank(j) @@ -550,7 +656,7 @@ PROGRAM H5_buildiface ! h5dread_f ! -! NAME +! NAME ! h5dread_f ! ! PURPOSE @@ -577,7 +683,7 @@ PROGRAM H5_buildiface ! Elena Pourmal ! August 12, 1999 ! -! HISTORY +! HISTORY ! Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows ! port). February 28, 2001 @@ -587,7 +693,7 @@ PROGRAM H5_buildiface ! the h5dwrite_reference_obj and h5dwrite_reference_dsetreg ! functions. April 2, 2001 ! -! NOTES +! NOTES ! This function is overloaded to read INTEGER, ! REAL, DOUBLE PRECISION and CHARACTER buffers ! up to 7 dimensions, and one dimensional buffers @@ -606,7 +712,6 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' SUBROUTINE h5dread_rkind_'//TRIM(ADJUSTL(chr2))& &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -646,7 +751,6 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' SUBROUTINE h5dread_ikind_'//TRIM(ADJUSTL(chr2))& &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -681,7 +785,6 @@ PROGRAM H5_buildiface ! Subroutine API WRITE(11,'(A)') ' SUBROUTINE h5dread_ckind_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -721,7 +824,6 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' SUBROUTINE h5dwrite_rkind_'//TRIM(ADJUSTL(chr2))& &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -760,7 +862,6 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' SUBROUTINE h5dwrite_ikind_'//TRIM(ADJUSTL(chr2))& &//'_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -785,7 +886,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' file_space_id_default, xfer_prp_default, f_ptr)' WRITE(11,'(A)') ' END SUBROUTINE h5dwrite_ikind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j) ENDDO - ENDDO + ENDDO DO j = 2, 8 ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -794,7 +895,6 @@ PROGRAM H5_buildiface ! Subroutine API WRITE(11,'(A)') ' SUBROUTINE h5dwrite_ckind_rank'//chr_rank(j)//'(dset_id, mem_type_id, buf, dims, hdferr, &' WRITE(11,'(A)') ' mem_space_id, file_space_id, xfer_prp)' - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: dset_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: mem_type_id' @@ -838,7 +938,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: prp_id' WRITE(11,'(A)') ' INTEGER(HID_T), INTENT(IN) :: type_id' - WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(IN), TARGET :: fillvalue' + WRITE(11,'(A)') ' REAL(KIND='//TRIM(ADJUSTL(chr2))//'), INTENT(IN), TARGET :: fillvalue' WRITE(11,'(A)') ' INTEGER, INTENT(OUT) :: hdferr ' WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr ' WRITE(11,'(A)') ' f_ptr = C_LOC(fillvalue)' @@ -889,7 +989,7 @@ PROGRAM H5_buildiface WRITE(11,'(A)') ' f_ptr = C_LOC(value)' WRITE(11,'(A)') ' name_len = LEN(name)' WRITE(11,'(A)') ' hdferr = h5pget_c(prp_id, name, name_len, f_ptr)' - + WRITE(11,'(A)') ' END SUBROUTINE h5pset_kind_'//TRIM(ADJUSTL(chr2)) ENDDO diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 352ffab..8044b78 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -56,7 +56,6 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes { int ret_value = -1; hid_t c_type_id; - size_t tmp_val; int i; /* Fortran INTEGER may not be the same as C; do all checking to find @@ -102,7 +101,7 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes if (sizeof(int_f) == sizeof(long long)) { if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value; } /*end else */ - + /* Find appropriate size to store Fortran REAL */ if(sizeof(real_f)==sizeof(float)) { if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value; @@ -133,8 +132,7 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes #endif if ((c_type_id = H5Tcopy(H5T_FORTRAN_S1)) < 0) return ret_value; - tmp_val = 1; - if(H5Tset_size(c_type_id, tmp_val) < 0) return ret_value; + if(H5Tset_size(c_type_id, 1) < 0) return ret_value; if(H5Tset_strpad(c_type_id, H5T_STR_SPACEPAD) < 0) return ret_value; types[8] = (hid_t_f)c_type_id; @@ -232,7 +230,7 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes if ((integertypes[12] = (hid_t_f)H5Tcopy(H5T_STD_U32BE)) < 0) return ret_value; if ((integertypes[13] = (hid_t_f)H5Tcopy(H5T_STD_U32LE)) < 0) return ret_value; if ((integertypes[14] = (hid_t_f)H5Tcopy(H5T_STD_U64BE)) < 0) return ret_value; - if ((integertypes[15] = (hid_t_f)H5Tcopy(H5T_STD_U64LE)) < 0) return ret_value; + if ((integertypes[15] = (hid_t_f)H5Tcopy(H5T_STD_U64LE)) < 0) return ret_value; if ((integertypes[17] = (hid_t_f)H5Tcopy(H5T_STD_B8BE)) < 0) return ret_value; if ((integertypes[18] = (hid_t_f)H5Tcopy(H5T_STD_B8LE)) < 0) return ret_value; if ((integertypes[19] = (hid_t_f)H5Tcopy(H5T_STD_B16BE)) < 0) return ret_value; @@ -313,6 +311,7 @@ h5close_types_c( hid_t_f * types, int_f *lentypes, ret_value = 0; return ret_value; } + /****if* H5_f/h5init_flags_c * NAME * h5init_flags_c @@ -360,17 +359,16 @@ h5close_types_c( hid_t_f * types, int_f *lentypes, * SOURCE */ int_f -h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, +h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, - hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, - int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, + hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, + int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags, haddr_t_f *h5_haddr_generic_flags) /******/ { - int ret_value = -1; /* * H5D flags */ @@ -443,7 +441,13 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, h5f_flags[15] = (int_f)H5F_OBJ_ALL; h5f_flags[16] = (int_f)H5F_LIBVER_EARLIEST; h5f_flags[17] = (int_f)H5F_LIBVER_LATEST; - h5f_flags[18] = (int_f)H5F_UNLIMITED; + h5f_flags[18] = (int_f)H5F_LIBVER_ERROR; + h5f_flags[19] = (int_f)H5F_LIBVER_NBOUNDS; + h5f_flags[20] = (int_f)H5F_UNLIMITED; + h5f_flags[21] = (int_f)H5F_LIBVER_V18; + h5f_flags[22] = (int_f)H5F_LIBVER_V110; + h5f_flags[23] = (int_f)H5F_LIBVER_V112; + h5f_flags[24] = (int_f)H5F_LIBVER_V114; /* * H5FD flags @@ -498,6 +502,16 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, h5i_flags[4] = (int_f)H5I_DATASET; h5i_flags[5] = (int_f)H5I_ATTR; h5i_flags[6] = (int_f)H5I_BADID; + h5i_flags[7] = (int_f)H5I_UNINIT; + h5i_flags[8] = (int_f)H5I_VFL; + h5i_flags[9] = (int_f)H5I_VOL; + h5i_flags[10] = (int_f)H5I_GENPROP_CLS; + h5i_flags[11] = (int_f)H5I_GENPROP_LST; + h5i_flags[12] = (int_f)H5I_ERROR_CLASS; + h5i_flags[13] = (int_f)H5I_ERROR_MSG; + h5i_flags[14] = (int_f)H5I_ERROR_STACK; + h5i_flags[15] = (int_f)H5I_NTYPES; + h5i_flags[16] = (int_f)H5I_INVALID_HID; /* * H5L flags */ @@ -528,191 +542,201 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, * but we need to assign each kind of message to a different bit so that * one index can hold multiple types.) */ - h5o_flags[7] = (int_f)H5O_SHMESG_NONE_FLAG; /* No shared messages */ - h5o_flags[8] = (int_f)H5O_SHMESG_SDSPACE_FLAG; /* Simple Dataspace Message. */ - h5o_flags[9] = (int_f)H5O_SHMESG_DTYPE_FLAG; /* Datatype Message. */ - h5o_flags[10] = (int_f)H5O_SHMESG_FILL_FLAG; /* Fill Value Message. */ - h5o_flags[11] = (int_f)H5O_SHMESG_PLINE_FLAG; /* Filter pipeline message. */ - h5o_flags[12] = (int_f)H5O_SHMESG_ATTR_FLAG; /* Attribute Message. */ - h5o_flags[13] = (int_f)H5O_SHMESG_ALL_FLAG; + h5o_flags[7] = (int_f)H5O_SHMESG_NONE_FLAG; /* No shared messages */ + h5o_flags[8] = (int_f)H5O_SHMESG_SDSPACE_FLAG; /* Simple Dataspace Message. */ + h5o_flags[9] = (int_f)H5O_SHMESG_DTYPE_FLAG; /* Datatype Message. */ + h5o_flags[10] = (int_f)H5O_SHMESG_FILL_FLAG; /* Fill Value Message. */ + h5o_flags[11] = (int_f)H5O_SHMESG_PLINE_FLAG; /* Filter pipeline message. */ + h5o_flags[12] = (int_f)H5O_SHMESG_ATTR_FLAG; /* Attribute Message. */ + h5o_flags[13] = (int_f)H5O_SHMESG_ALL_FLAG; /* Object header status flag definitions */ - h5o_flags[14] = (int_f)H5O_HDR_CHUNK0_SIZE; /* 2-bit field indicating # of bytes to store the size of chunk 0's data */ - h5o_flags[15] = (int_f)H5O_HDR_ATTR_CRT_ORDER_TRACKED; /* Attribute creation order is tracked */ - h5o_flags[16] = (int_f)H5O_HDR_ATTR_CRT_ORDER_INDEXED; /* Attribute creation order has index */ - h5o_flags[17] = (int_f)H5O_HDR_ATTR_STORE_PHASE_CHANGE; /* Non-default attribute storage phase change values stored */ - h5o_flags[18] = (int_f)H5O_HDR_STORE_TIMES; /* Store access, modification, change & birth times for object */ - h5o_flags[19] = (int_f)H5O_HDR_ALL_FLAGS; + h5o_flags[14] = (int_f)H5O_HDR_CHUNK0_SIZE; /* 2-bit field indicating # of bytes to store the size of chunk 0's data */ + h5o_flags[15] = (int_f)H5O_HDR_ATTR_CRT_ORDER_TRACKED; /* Attribute creation order is tracked */ + h5o_flags[16] = (int_f)H5O_HDR_ATTR_CRT_ORDER_INDEXED; /* Attribute creation order has index */ + h5o_flags[17] = (int_f)H5O_HDR_ATTR_STORE_PHASE_CHANGE; /* Non-default attribute storage phase change values stored */ + h5o_flags[18] = (int_f)H5O_HDR_STORE_TIMES; /* Store access, modification, change & birth times for object */ + h5o_flags[19] = (int_f)H5O_HDR_ALL_FLAGS; /* Maximum shared message values. Number of indexes is 8 to allow room to add * new types of messages. */ - h5o_flags[20] = (int_f)H5O_SHMESG_MAX_NINDEXES; - h5o_flags[21] = (int_f)H5O_SHMESG_MAX_LIST_SIZE; + h5o_flags[20] = (int_f)H5O_SHMESG_MAX_NINDEXES; + h5o_flags[21] = (int_f)H5O_SHMESG_MAX_LIST_SIZE; /* Types of objects in file */ - h5o_flags[22] = (int_f)H5O_TYPE_UNKNOWN; /* Unknown object type */ - h5o_flags[23] = (int_f)H5O_TYPE_GROUP; /* Object is a group */ - h5o_flags[24] = (int_f)H5O_TYPE_DATASET; /* Object is a dataset */ - h5o_flags[25] = (int_f)H5O_TYPE_NAMED_DATATYPE; /* Object is a named data type */ - h5o_flags[26] = (int_f)H5O_TYPE_NTYPES; /* Number of different object types */ + h5o_flags[22] = (int_f)H5O_TYPE_UNKNOWN; /* Unknown object type */ + h5o_flags[23] = (int_f)H5O_TYPE_GROUP; /* Object is a group */ + h5o_flags[24] = (int_f)H5O_TYPE_DATASET; /* Object is a dataset */ + h5o_flags[25] = (int_f)H5O_TYPE_NAMED_DATATYPE; /* Object is a named data type */ + h5o_flags[26] = (int_f)H5O_TYPE_NTYPES; /* Number of different object types */ + +/* Flags for H5Oget_info. + * These flags determine which fields will be filled in in the H5O_info_t + * struct. + */ + h5o_flags[27] = (int_f)H5O_INFO_ALL; /* (H5O_INFO_BASIC|H5O_INFO_TIME|H5O_INFO_NUM_ATTRS) */ + h5o_flags[28] = (int_f)H5O_INFO_BASIC; /* Fill in the fileno, addr, type, and rc fields */ + h5o_flags[29] = (int_f)H5O_INFO_TIME; /* Fill in the atime, mtime, ctime, and btime fields */ + h5o_flags[30] = (int_f)H5O_INFO_NUM_ATTRS; /* Fill in the num_attrs field */ + +/* Flags for H5Oget_native_info. + * These flags determine which fields will be filled in in the H5O_native_info_t + * struct. + */ + h5o_flags[31] = (int_f)H5O_NATIVE_INFO_ALL; /* (H5O_NATIVE_INFO_HDR|H5O_NATIVE_INFO_META_SIZE) */ + h5o_flags[32] = (int_f)H5O_NATIVE_INFO_HDR; /* Fill in the hdr field */ + h5o_flags[33] = (int_f)H5O_NATIVE_INFO_META_SIZE; /* Fill in the meta_size field */ /* * H5P flags */ - h5p_flags[0] = (hid_t_f)H5P_FILE_CREATE; - h5p_flags[1] = (hid_t_f)H5P_FILE_ACCESS; - h5p_flags[2] = (hid_t_f)H5P_DATASET_CREATE; - h5p_flags[3] = (hid_t_f)H5P_DATASET_XFER; - h5p_flags[4] = (hid_t_f)H5P_FILE_MOUNT; - h5p_flags[5] = (hid_t_f)H5P_DEFAULT; - h5p_flags[6] = (hid_t_f)H5P_ROOT; - h5p_flags[7] = (hid_t_f)H5P_OBJECT_CREATE; - h5p_flags[8] = (hid_t_f)H5P_DATASET_ACCESS; - h5p_flags[9] = (hid_t_f)H5P_GROUP_CREATE; - h5p_flags[10] = (hid_t_f)H5P_GROUP_ACCESS; - h5p_flags[11] = (hid_t_f)H5P_DATATYPE_CREATE; - h5p_flags[12] = (hid_t_f)H5P_DATATYPE_ACCESS; - h5p_flags[13] = (hid_t_f)H5P_STRING_CREATE; - h5p_flags[14] = (hid_t_f)H5P_ATTRIBUTE_CREATE; - h5p_flags[15] = (hid_t_f)H5P_OBJECT_COPY; - h5p_flags[16] = (hid_t_f)H5P_LINK_CREATE; - h5p_flags[17] = (hid_t_f)H5P_LINK_ACCESS; + h5p_flags[0] = (hid_t_f)H5P_FILE_CREATE; + h5p_flags[1] = (hid_t_f)H5P_FILE_ACCESS; + h5p_flags[2] = (hid_t_f)H5P_DATASET_CREATE; + h5p_flags[3] = (hid_t_f)H5P_DATASET_XFER; + h5p_flags[4] = (hid_t_f)H5P_FILE_MOUNT; + h5p_flags[5] = (hid_t_f)H5P_DEFAULT; + h5p_flags[6] = (hid_t_f)H5P_ROOT; + h5p_flags[7] = (hid_t_f)H5P_OBJECT_CREATE; + h5p_flags[8] = (hid_t_f)H5P_DATASET_ACCESS; + h5p_flags[9] = (hid_t_f)H5P_GROUP_CREATE; + h5p_flags[10] = (hid_t_f)H5P_GROUP_ACCESS; + h5p_flags[11] = (hid_t_f)H5P_DATATYPE_CREATE; + h5p_flags[12] = (hid_t_f)H5P_DATATYPE_ACCESS; + h5p_flags[13] = (hid_t_f)H5P_STRING_CREATE; + h5p_flags[14] = (hid_t_f)H5P_ATTRIBUTE_CREATE; + h5p_flags[15] = (hid_t_f)H5P_OBJECT_COPY; + h5p_flags[16] = (hid_t_f)H5P_LINK_CREATE; + h5p_flags[17] = (hid_t_f)H5P_LINK_ACCESS; /* * H5P integer flags */ - h5p_flags_int[0] = (int_f)H5P_CRT_ORDER_INDEXED; - h5p_flags_int[1] = (int_f)H5P_CRT_ORDER_TRACKED; + h5p_flags_int[0] = (int_f)H5P_CRT_ORDER_INDEXED; + h5p_flags_int[1] = (int_f)H5P_CRT_ORDER_TRACKED; /* * H5R flags */ - - h5r_flags[0] = (int_f)H5R_OBJECT; - h5r_flags[1] = (int_f)H5R_DATASET_REGION; + h5r_flags[0] = (int_f)H5R_OBJECT; + h5r_flags[1] = (int_f)H5R_DATASET_REGION; /* * H5S flags */ - - h5s_hid_flags[0] = (hid_t_f)H5S_ALL; + h5s_hid_flags[0] = (hid_t_f)H5S_ALL; - h5s_hsize_flags[0] = (hsize_t_f)H5S_UNLIMITED; + h5s_hsize_flags[0] = (hsize_t_f)H5S_UNLIMITED; - h5s_flags[0] = (int_f)H5S_SCALAR; - h5s_flags[1] = (int_f)H5S_SIMPLE; - h5s_flags[2] = (int_f)H5S_NULL; - h5s_flags[3] = (int_f)H5S_SELECT_SET; - h5s_flags[4] = (int_f)H5S_SELECT_OR; + h5s_flags[0] = (int_f)H5S_SCALAR; + h5s_flags[1] = (int_f)H5S_SIMPLE; + h5s_flags[2] = (int_f)H5S_NULL; + h5s_flags[3] = (int_f)H5S_SELECT_SET; + h5s_flags[4] = (int_f)H5S_SELECT_OR; - h5s_flags[5] = (int_f)H5S_SELECT_NOOP; - h5s_flags[6] = (int_f)H5S_SELECT_AND; - h5s_flags[7] = (int_f)H5S_SELECT_XOR; - h5s_flags[8] = (int_f)H5S_SELECT_NOTB; - h5s_flags[9] = (int_f)H5S_SELECT_NOTA; + h5s_flags[5] = (int_f)H5S_SELECT_NOOP; + h5s_flags[6] = (int_f)H5S_SELECT_AND; + h5s_flags[7] = (int_f)H5S_SELECT_XOR; + h5s_flags[8] = (int_f)H5S_SELECT_NOTB; + h5s_flags[9] = (int_f)H5S_SELECT_NOTA; - h5s_flags[10] = (int_f)H5S_SELECT_APPEND; - h5s_flags[11] = (int_f)H5S_SELECT_PREPEND; - h5s_flags[12] = (int_f)H5S_SELECT_INVALID; - h5s_flags[13] = (int_f)H5S_SEL_ERROR; - h5s_flags[14] = (int_f)H5S_SEL_NONE; + h5s_flags[10] = (int_f)H5S_SELECT_APPEND; + h5s_flags[11] = (int_f)H5S_SELECT_PREPEND; + h5s_flags[12] = (int_f)H5S_SELECT_INVALID; + h5s_flags[13] = (int_f)H5S_SEL_ERROR; + h5s_flags[14] = (int_f)H5S_SEL_NONE; - h5s_flags[15] = (int_f)H5S_SEL_POINTS; - h5s_flags[16] = (int_f)H5S_SEL_HYPERSLABS; - h5s_flags[17] = (int_f)H5S_SEL_ALL; + h5s_flags[15] = (int_f)H5S_SEL_POINTS; + h5s_flags[16] = (int_f)H5S_SEL_HYPERSLABS; + h5s_flags[17] = (int_f)H5S_SEL_ALL; /* * H5T flags */ - h5t_flags[0] = (int_f)H5T_NO_CLASS; - h5t_flags[1] = (int_f)H5T_INTEGER; - h5t_flags[2] = (int_f)H5T_FLOAT; - h5t_flags[3] = (int_f)H5T_TIME; - h5t_flags[4] = (int_f)H5T_STRING; - h5t_flags[5] = (int_f)H5T_BITFIELD; - h5t_flags[6] = (int_f)H5T_OPAQUE; - h5t_flags[7] = (int_f)H5T_COMPOUND; - h5t_flags[8] = (int_f)H5T_REFERENCE; - h5t_flags[9] = (int_f)H5T_ENUM; - h5t_flags[10] = (int_f)H5T_ORDER_LE; - h5t_flags[11] = (int_f)H5T_ORDER_BE; - h5t_flags[12] = (int_f)H5T_ORDER_MIXED; - h5t_flags[13] = (int_f)H5T_ORDER_VAX; - h5t_flags[14] = (int_f)H5T_ORDER_NONE; - h5t_flags[15] = (int_f)H5T_PAD_ZERO; - h5t_flags[16] = (int_f)H5T_PAD_ONE; - h5t_flags[17] = (int_f)H5T_PAD_BACKGROUND; - h5t_flags[18] = (int_f)H5T_PAD_ERROR; - h5t_flags[19] = (int_f)H5T_SGN_NONE; - h5t_flags[20] = (int_f)H5T_SGN_2; - h5t_flags[21] = (int_f)H5T_SGN_ERROR; - h5t_flags[22] = (int_f)H5T_NORM_IMPLIED; - h5t_flags[23] = (int_f)H5T_NORM_MSBSET; - h5t_flags[24] = (int_f)H5T_NORM_NONE; - h5t_flags[25] = (int_f)H5T_CSET_ASCII; - h5t_flags[26] = (int_f)H5T_CSET_UTF8; - h5t_flags[27] = (int_f)H5T_STR_NULLTERM; - h5t_flags[28] = (int_f)H5T_STR_NULLPAD; - h5t_flags[29] = (int_f)H5T_STR_SPACEPAD; - h5t_flags[30] = (int_f)H5T_STR_ERROR; - h5t_flags[31] = (int_f)H5T_VLEN; - h5t_flags[32] = (int_f)H5T_ARRAY; - h5t_flags[33] = (int_f)H5T_DIR_ASCEND; - h5t_flags[34] = (int_f)H5T_DIR_DESCEND; + h5t_flags[0] = (int_f)H5T_NO_CLASS; + h5t_flags[1] = (int_f)H5T_INTEGER; + h5t_flags[2] = (int_f)H5T_FLOAT; + h5t_flags[3] = (int_f)H5T_TIME; + h5t_flags[4] = (int_f)H5T_STRING; + h5t_flags[5] = (int_f)H5T_BITFIELD; + h5t_flags[6] = (int_f)H5T_OPAQUE; + h5t_flags[7] = (int_f)H5T_COMPOUND; + h5t_flags[8] = (int_f)H5T_REFERENCE; + h5t_flags[9] = (int_f)H5T_ENUM; + h5t_flags[10] = (int_f)H5T_ORDER_LE; + h5t_flags[11] = (int_f)H5T_ORDER_BE; + h5t_flags[12] = (int_f)H5T_ORDER_MIXED; + h5t_flags[13] = (int_f)H5T_ORDER_VAX; + h5t_flags[14] = (int_f)H5T_ORDER_NONE; + h5t_flags[15] = (int_f)H5T_PAD_ZERO; + h5t_flags[16] = (int_f)H5T_PAD_ONE; + h5t_flags[17] = (int_f)H5T_PAD_BACKGROUND; + h5t_flags[18] = (int_f)H5T_PAD_ERROR; + h5t_flags[19] = (int_f)H5T_SGN_NONE; + h5t_flags[20] = (int_f)H5T_SGN_2; + h5t_flags[21] = (int_f)H5T_SGN_ERROR; + h5t_flags[22] = (int_f)H5T_NORM_IMPLIED; + h5t_flags[23] = (int_f)H5T_NORM_MSBSET; + h5t_flags[24] = (int_f)H5T_NORM_NONE; + h5t_flags[25] = (int_f)H5T_CSET_ASCII; + h5t_flags[26] = (int_f)H5T_CSET_UTF8; + h5t_flags[27] = (int_f)H5T_STR_NULLTERM; + h5t_flags[28] = (int_f)H5T_STR_NULLPAD; + h5t_flags[29] = (int_f)H5T_STR_SPACEPAD; + h5t_flags[30] = (int_f)H5T_STR_ERROR; + h5t_flags[31] = (int_f)H5T_VLEN; + h5t_flags[32] = (int_f)H5T_ARRAY; + h5t_flags[33] = (int_f)H5T_DIR_ASCEND; + h5t_flags[34] = (int_f)H5T_DIR_DESCEND; /* * H5Z flags */ - h5z_flags[0] = (int_f)H5Z_FILTER_ERROR; - h5z_flags[1] = (int_f)H5Z_FILTER_NONE; - h5z_flags[2] = (int_f)H5Z_FILTER_DEFLATE; - h5z_flags[3] = (int_f)H5Z_FILTER_SHUFFLE; - h5z_flags[4] = (int_f)H5Z_FILTER_FLETCHER32; - h5z_flags[5] = (int_f)H5Z_ERROR_EDC; - h5z_flags[6] = (int_f)H5Z_DISABLE_EDC; - h5z_flags[7] = (int_f)H5Z_ENABLE_EDC; - h5z_flags[8] = (int_f)H5Z_NO_EDC; - h5z_flags[9] = (int_f)H5Z_FILTER_SZIP; - h5z_flags[10] = (int_f)H5Z_FLAG_OPTIONAL; - h5z_flags[11] = (int_f)H5Z_FILTER_CONFIG_ENCODE_ENABLED; - h5z_flags[12] = (int_f)H5Z_FILTER_CONFIG_DECODE_ENABLED; - h5z_flags[13] = (int_f)H5Z_FILTER_ALL; - h5z_flags[14] = (int_f)H5Z_FILTER_NBIT; - h5z_flags[15] = (int_f)H5Z_FILTER_SCALEOFFSET; - h5z_flags[16] = (int_f)H5Z_SO_FLOAT_DSCALE; - h5z_flags[17] = (int_f)H5Z_SO_FLOAT_ESCALE; - h5z_flags[18] = (int_f)H5Z_SO_INT; - h5z_flags[19] = (int_f)H5Z_SO_INT_MINBITS_DEFAULT; -/* - * H5A flags - */ - + h5z_flags[0] = (int_f)H5Z_FILTER_ERROR; + h5z_flags[1] = (int_f)H5Z_FILTER_NONE; + h5z_flags[2] = (int_f)H5Z_FILTER_DEFLATE; + h5z_flags[3] = (int_f)H5Z_FILTER_SHUFFLE; + h5z_flags[4] = (int_f)H5Z_FILTER_FLETCHER32; + h5z_flags[5] = (int_f)H5Z_ERROR_EDC; + h5z_flags[6] = (int_f)H5Z_DISABLE_EDC; + h5z_flags[7] = (int_f)H5Z_ENABLE_EDC; + h5z_flags[8] = (int_f)H5Z_NO_EDC; + h5z_flags[9] = (int_f)H5Z_FILTER_SZIP; + h5z_flags[10] = (int_f)H5Z_FLAG_OPTIONAL; + h5z_flags[11] = (int_f)H5Z_FILTER_CONFIG_ENCODE_ENABLED; + h5z_flags[12] = (int_f)H5Z_FILTER_CONFIG_DECODE_ENABLED; + h5z_flags[13] = (int_f)H5Z_FILTER_ALL; + h5z_flags[14] = (int_f)H5Z_FILTER_NBIT; + h5z_flags[15] = (int_f)H5Z_FILTER_SCALEOFFSET; + h5z_flags[16] = (int_f)H5Z_SO_FLOAT_DSCALE; + h5z_flags[17] = (int_f)H5Z_SO_FLOAT_ESCALE; + h5z_flags[18] = (int_f)H5Z_SO_INT; + h5z_flags[19] = (int_f)H5Z_SO_INT_MINBITS_DEFAULT; /* * H5 Generic flags introduced in version 1.8 */ - /* H5_index_t enum struct */ + /* H5_index_t enum struct */ - h5_generic_flags[0] = (int_f)H5_INDEX_UNKNOWN; /* Unknown index type */ - h5_generic_flags[1] = (int_f)H5_INDEX_NAME; /* Index on names */ - h5_generic_flags[2] = (int_f)H5_INDEX_CRT_ORDER; /* Index on creation order */ - h5_generic_flags[3] = (int_f)H5_INDEX_N; /* Index on creation order */ + h5_generic_flags[0] = (int_f)H5_INDEX_UNKNOWN; /* Unknown index type */ + h5_generic_flags[1] = (int_f)H5_INDEX_NAME; /* Index on names */ + h5_generic_flags[2] = (int_f)H5_INDEX_CRT_ORDER; /* Index on creation order */ + h5_generic_flags[3] = (int_f)H5_INDEX_N; /* Index on creation order */ - /* H5_iter_order_t enum struct */ + /* H5_iter_order_t enum struct */ - h5_generic_flags[4] = (int_f)H5_ITER_UNKNOWN; /* Unknown order */ - h5_generic_flags[5] = (int_f)H5_ITER_INC; /* Increasing order */ - h5_generic_flags[6] = (int_f)H5_ITER_DEC; /* Decreasing order */ - h5_generic_flags[7] = (int_f)H5_ITER_NATIVE; /* No particular order, whatever is fastest */ - h5_generic_flags[8] = (int_f)H5_ITER_N; /* Number of iteration orders */ + h5_generic_flags[4] = (int_f)H5_ITER_UNKNOWN; /* Unknown order */ + h5_generic_flags[5] = (int_f)H5_ITER_INC; /* Increasing order */ + h5_generic_flags[6] = (int_f)H5_ITER_DEC; /* Decreasing order */ + h5_generic_flags[7] = (int_f)H5_ITER_NATIVE; /* No particular order, whatever is fastest */ + h5_generic_flags[8] = (int_f)H5_ITER_N; /* Number of iteration orders */ - h5_haddr_generic_flags[0] = (haddr_t_f)HADDR_UNDEF; /* undefined address */ + h5_haddr_generic_flags[0] = (haddr_t_f)HADDR_UNDEF; /* undefined address */ - ret_value = 0; - return ret_value; + return 0; } int_f diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index ef89d2f..2c32277 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -38,10 +38,112 @@ MODULE H5LIB - USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, C_INTPTR_T + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_INTPTR_T USE H5GLOBAL IMPLICIT NONE + PRIVATE + ! + ! H5F flags declaration + ! + INTEGER, PARAMETER :: H5F_FLAGS_LEN = 25 + INTEGER, DIMENSION(1:H5F_FLAGS_LEN) :: H5F_flags + ! + ! H5generic flags declaration + ! + INTEGER, PARAMETER :: H5generic_FLAGS_LEN = 9 + INTEGER, DIMENSION(1:H5generic_FLAGS_LEN) :: H5generic_flags + + INTEGER, PARAMETER :: H5generic_haddr_FLAGS_LEN = 1 + INTEGER(HADDR_T), DIMENSION(1:H5generic_haddr_FLAGS_LEN) :: H5generic_haddr_flags + ! + ! H5G flags declaration + ! + INTEGER, PARAMETER :: H5G_FLAGS_LEN = 12 + INTEGER, DIMENSION(1:H5G_FLAGS_LEN) :: H5G_flags + ! + ! H5D flags declaration + ! + INTEGER, PARAMETER :: H5D_FLAGS_LEN = 29 + INTEGER, DIMENSION(1:H5D_FLAGS_LEN) :: H5D_flags + INTEGER, PARAMETER :: H5D_SIZE_FLAGS_LEN = 2 + INTEGER(SIZE_T), DIMENSION(1:H5D_SIZE_FLAGS_LEN) :: H5D_size_flags + ! + ! H5E flags declaration + ! + INTEGER, PARAMETER :: H5E_FLAGS_LEN = 4 + INTEGER, DIMENSION(1:H5E_FLAGS_LEN) :: H5E_flags + INTEGER, PARAMETER :: H5E_HID_FLAGS_LEN = 1 + INTEGER(HID_T), DIMENSION(1:H5E_HID_FLAGS_LEN) :: H5E_hid_flags + ! + ! H5FD flags declaration + ! + INTEGER, PARAMETER :: H5FD_FLAGS_LEN = 11 + INTEGER, DIMENSION(1:H5FD_FLAGS_LEN) :: H5FD_flags + ! + ! H5FD file drivers flags declaration + ! + INTEGER, PARAMETER :: H5FD_HID_FLAGS_LEN = 7 + INTEGER(HID_T), DIMENSION(1:H5FD_HID_FLAGS_LEN) :: H5FD_hid_flags + ! + ! H5I flags declaration + ! + INTEGER, PARAMETER :: H5I_FLAGS_LEN = 17 + INTEGER, DIMENSION(1:H5I_FLAGS_LEN) :: H5I_flags + ! + ! H5L flags declaration + ! + INTEGER, PARAMETER :: H5L_FLAGS_LEN = 6 + INTEGER, DIMENSION(1:H5L_FLAGS_LEN) :: H5L_flags + ! + ! H5O flags declaration + ! + INTEGER, PARAMETER :: H5O_FLAGS_LEN = 33 + INTEGER, DIMENSION(1:H5O_FLAGS_LEN) :: H5O_flags + ! + ! H5P flags declaration + ! + INTEGER, PARAMETER :: H5P_FLAGS_LEN = 18 + INTEGER(HID_T), DIMENSION(1:H5P_FLAGS_LEN) :: H5P_flags + ! + ! H5P integers flags declaration + ! + INTEGER, PARAMETER :: H5P_FLAGS_INT_LEN = 2 + INTEGER, DIMENSION(1:H5P_FLAGS_INT_LEN) :: H5P_flags_int + ! + ! H5R flags declaration + ! + INTEGER, PARAMETER :: H5R_FLAGS_LEN = 2 + INTEGER, DIMENSION(1:H5R_FLAGS_LEN) :: H5R_flags + ! + ! H5S flags declaration + ! + INTEGER, PARAMETER :: H5S_FLAGS_LEN = 18 + INTEGER, DIMENSION(1:H5S_FLAGS_LEN) :: H5S_flags + INTEGER, PARAMETER :: H5S_HSIZE_FLAGS_LEN = 1 + INTEGER(HSIZE_T), DIMENSION(1:H5S_HSIZE_FLAGS_LEN) :: H5S_hsize_flags + INTEGER, PARAMETER :: H5S_HID_FLAGS_LEN = 1 + INTEGER(HSIZE_T), DIMENSION(1:H5S_HID_FLAGS_LEN) :: H5S_hid_flags + ! + ! H5T flags declaration + ! + INTEGER, PARAMETER :: H5T_FLAGS_LEN = 35 + INTEGER, DIMENSION(1:H5T_FLAGS_LEN) :: H5T_flags + + ! + ! H5Z flags declaration + ! + INTEGER, PARAMETER :: H5Z_FLAGS_LEN = 20 + INTEGER, DIMENSION(1:H5Z_FLAGS_LEN) :: H5Z_flags + ! + ! H5 Library flags declaration + ! + INTEGER, PARAMETER :: H5LIB_FLAGS_LEN = 2 + INTEGER, DIMENSION(1:H5LIB_FLAGS_LEN) :: H5LIB_flags + + PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof, h5gmtime + PUBLIC :: h5garbage_collect_f, h5check_version_f + CONTAINS !****s* H5LIB/h5open_f ! @@ -65,26 +167,26 @@ CONTAINS ! ! Removed call to h5open_c since this may cause a problem for an ! application that uses HDF5 library outside HDF5 Fortran APIs. -! October 13, 2011 +! October 13, 2011 ! Fortran90 Interface: SUBROUTINE h5open_f(error) + USE H5F, ONLY : h5fget_obj_count_f, H5OPEN_NUM_OBJ IMPLICIT NONE INTEGER, INTENT(OUT) :: error + INTEGER(SIZE_T) :: H5OPEN_NUM_OBJ_LOC = 0 !***** - INTEGER :: error_1, error_2, error_3 - INTERFACE + INTEGER FUNCTION h5init_types_c(p_types, f_types, i_types) & BIND(C,NAME='h5init_types_c') IMPORT :: HID_T IMPORT :: PREDEF_TYPES_LEN, FLOATING_TYPES_LEN, INTEGER_TYPES_LEN IMPLICIT NONE - INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: i_types + INTEGER(HID_T), DIMENSION(1:PREDEF_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(1:FLOATING_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(1:INTEGER_TYPES_LEN) :: i_types END FUNCTION h5init_types_c - END INTERFACE - INTERFACE + INTEGER FUNCTION h5init_flags_c(i_H5D_flags, & i_H5D_size_flags,& i_H5E_flags, & @@ -116,39 +218,90 @@ CONTAINS H5R_FLAGS_LEN, H5S_FLAGS_LEN, H5S_HID_FLAGS_LEN, H5S_HSIZE_FLAGS_LEN, & H5T_FLAGS_LEN, H5Z_FLAGS_LEN, H5generic_FLAGS_LEN, H5generic_haddr_FLAGS_LEN IMPLICIT NONE - INTEGER i_H5D_flags(H5D_FLAGS_LEN) - INTEGER(SIZE_T) i_H5D_size_flags(H5D_SIZE_FLAGS_LEN) - INTEGER i_H5E_flags(H5E_FLAGS_LEN) - INTEGER(HID_T) i_H5E_hid_flags(H5E_HID_FLAGS_LEN) - INTEGER i_H5F_flags(H5F_FLAGS_LEN) - INTEGER i_H5G_flags(H5G_FLAGS_LEN) - INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) - INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) - INTEGER i_H5I_flags(H5I_FLAGS_LEN) - INTEGER i_H5L_flags(H5L_FLAGS_LEN) - INTEGER i_H5O_flags(H5O_FLAGS_LEN) - INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) - INTEGER i_H5P_flags_int(H5P_FLAGS_INT_LEN) - INTEGER i_H5R_flags(H5R_FLAGS_LEN) - INTEGER i_H5S_flags(H5S_FLAGS_LEN) - INTEGER(HID_T) i_H5S_hid_flags(H5S_HID_FLAGS_LEN) - INTEGER(HSIZE_T) i_H5S_hsize_flags(H5S_HSIZE_FLAGS_LEN) - INTEGER i_H5T_flags(H5T_FLAGS_LEN) - INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) - INTEGER i_H5generic_flags(H5generic_FLAGS_LEN) - INTEGER(HADDR_T) i_H5generic_haddr_flags(H5generic_haddr_FLAGS_LEN) + INTEGER , DIMENSION(1:H5D_FLAGS_LEN) :: i_H5D_flags + INTEGER(SIZE_T) , DIMENSION(1:H5D_SIZE_FLAGS_LEN) :: i_H5D_size_flags + INTEGER , DIMENSION(1:H5E_FLAGS_LEN) :: i_H5E_flags + INTEGER(HID_T) , DIMENSION(1:H5E_HID_FLAGS_LEN) :: i_H5E_hid_flags + INTEGER , DIMENSION(1:H5F_FLAGS_LEN) :: i_H5F_flags + INTEGER , DIMENSION(1:H5G_FLAGS_LEN) :: i_H5G_flags + INTEGER , DIMENSION(1:H5FD_FLAGS_LEN) :: i_H5FD_flags + INTEGER(HID_T) , DIMENSION(1:H5FD_HID_FLAGS_LEN) :: i_H5FD_hid_flags + INTEGER , DIMENSION(1:H5I_FLAGS_LEN) :: i_H5I_flags + INTEGER , DIMENSION(1:H5L_FLAGS_LEN) :: i_H5L_flags + INTEGER , DIMENSION(1:H5O_FLAGS_LEN) :: i_H5O_flags + INTEGER(HID_T) , DIMENSION(1:H5P_FLAGS_LEN) :: i_H5P_flags + INTEGER , DIMENSION(1:H5P_FLAGS_INT_LEN) :: i_H5P_flags_int + INTEGER , DIMENSION(1:H5R_FLAGS_LEN) :: i_H5R_flags + INTEGER , DIMENSION(1:H5S_FLAGS_LEN) :: i_H5S_flags + INTEGER(HID_T) , DIMENSION(1:H5S_HID_FLAGS_LEN) :: i_H5S_hid_flags + INTEGER(HSIZE_T), DIMENSION(1:H5S_HSIZE_FLAGS_LEN) :: i_H5S_hsize_flags + INTEGER , DIMENSION(1:H5T_FLAGS_LEN) :: i_H5T_flags + INTEGER , DIMENSION(1:H5Z_FLAGS_LEN) :: i_H5Z_flags + INTEGER , DIMENSION(1:H5generic_FLAGS_LEN) :: i_H5generic_flags + INTEGER(HADDR_T), DIMENSION(1:H5generic_haddr_FLAGS_LEN) :: i_H5generic_haddr_flags END FUNCTION h5init_flags_c - END INTERFACE - INTERFACE + INTEGER FUNCTION h5init1_flags_c( i_H5LIB_flags ) & BIND(C,NAME='h5init1_flags_c') IMPORT :: H5LIB_FLAGS_LEN IMPLICIT NONE - INTEGER i_H5LIB_flags(H5LIB_FLAGS_LEN) + INTEGER, DIMENSION(1:H5LIB_FLAGS_LEN) :: i_H5LIB_flags END FUNCTION h5init1_flags_c + END INTERFACE - error_1 = h5init_types_c(predef_types, floating_types, integer_types) - error_2 = h5init_flags_c(H5D_flags, & + + error = h5init_types_c(predef_types, floating_types, integer_types) + + H5T_NATIVE_INTEGER_KIND(1:5) = predef_types(1:5) + H5T_NATIVE_INTEGER = predef_types(6) + H5T_NATIVE_REAL = predef_types(7) + H5T_NATIVE_DOUBLE = predef_types(8) + H5T_NATIVE_CHARACTER = predef_types(9) + H5T_STD_REF_OBJ = predef_types(10) + H5T_STD_REF_DSETREG = predef_types(11) + H5T_NATIVE_REAL_C_FLOAT = predef_types(12) + H5T_NATIVE_REAL_C_DOUBLE = predef_types(13) + H5T_NATIVE_REAL_C_LONG_DOUBLE = predef_types(14) + H5T_NATIVE_B8 = predef_types(15) + H5T_NATIVE_B16 = predef_types(16) + H5T_NATIVE_B32 = predef_types(17) + H5T_NATIVE_B64 = predef_types(18) + H5T_NATIVE_FLOAT_128 = predef_types(19) + + H5T_IEEE_F32BE = floating_types(1) + H5T_IEEE_F32LE = floating_types(2) + H5T_IEEE_F64BE = floating_types(3) + H5T_IEEE_F64LE = floating_types(4) + + H5T_STD_I8BE = integer_types(1) + H5T_STD_I8LE = integer_types(2) + H5T_STD_I16BE = integer_types(3) + H5T_STD_I16LE = integer_types(4) + H5T_STD_I32BE = integer_types(5) + H5T_STD_I32LE = integer_types(6) + H5T_STD_I64BE = integer_types(7) + H5T_STD_I64LE = integer_types(8) + H5T_STD_U8BE = integer_types(9) + H5T_STD_U8LE = integer_types(10) + H5T_STD_U16BE = integer_types(11) + H5T_STD_U16LE = integer_types(12) + H5T_STD_U32BE = integer_types(13) + H5T_STD_U32LE = integer_types(14) + H5T_STD_U64BE = integer_types(15) + H5T_STD_U64LE = integer_types(16) + H5T_STRING = integer_types(17) + H5T_STD_B8BE = integer_types(18) + H5T_STD_B8LE = integer_types(19) + H5T_STD_B16BE = integer_types(20) + H5T_STD_B16LE = integer_types(21) + H5T_STD_B32BE = integer_types(22) + H5T_STD_B32LE = integer_types(23) + H5T_STD_B64BE = integer_types(24) + H5T_STD_B64LE = integer_types(25) + H5T_FORTRAN_S1 = integer_types(26) + H5T_C_S1 = integer_types(27) + + error = error + h5init_flags_c(H5D_flags, & H5D_size_flags, & H5E_flags, & H5E_hid_flags, & @@ -169,8 +322,325 @@ CONTAINS H5Z_flags, & H5generic_flags,& H5generic_haddr_flags) - error_3 = h5init1_flags_c(H5LIB_flags ) - error = error_1 + error_2 + error_3 + ! + ! H5F flags + ! + H5F_ACC_RDWR_F = H5F_flags(1) + H5F_ACC_RDONLY_F = H5F_flags(2) + H5F_ACC_TRUNC_F = H5F_flags(3) + H5F_ACC_EXCL_F = H5F_flags(4) + H5F_ACC_DEBUG_F = H5F_flags(5) + H5F_SCOPE_LOCAL_F = H5F_flags(6) + H5F_SCOPE_GLOBAL_F = H5F_flags(7) + H5F_CLOSE_DEFAULT_F = H5F_flags(8) + H5F_CLOSE_WEAK_F = H5F_flags(9) + H5F_CLOSE_SEMI_F = H5F_flags(10) + H5F_CLOSE_STRONG_F = H5F_flags(11) + H5F_OBJ_FILE_F = H5F_flags(12) + H5F_OBJ_DATASET_F = H5F_flags(13) + H5F_OBJ_GROUP_F = H5F_flags(14) + H5F_OBJ_DATATYPE_F = H5F_flags(15) + H5F_OBJ_ALL_F = H5F_flags(16) + H5F_LIBVER_EARLIEST_F = H5F_flags(17) + H5F_LIBVER_LATEST_F = H5F_flags(18) + H5F_LIBVER_ERROR_F = H5F_flags(19) + H5F_LIBVER_NBOUNDS_F = H5F_flags(20) + H5F_UNLIMITED_F = H5F_flags(21) + H5F_LIBVER_V18_F = H5F_flags(22) + H5F_LIBVER_V110_F = H5F_flags(23) + H5F_LIBVER_V112_F = H5F_flags(24) + H5F_LIBVER_V114_F = H5F_flags(25) + ! + ! H5generic flags + ! + H5_INDEX_UNKNOWN_F = H5generic_flags(1) + H5_INDEX_NAME_F = H5generic_flags(2) + H5_INDEX_CRT_ORDER_F = H5generic_flags(3) + H5_INDEX_N_F = H5generic_flags(4) + H5_ITER_UNKNOWN_F = H5generic_flags(5) + H5_ITER_INC_F = H5generic_flags(6) + H5_ITER_DEC_F = H5generic_flags(7) + H5_ITER_NATIVE_F = H5generic_flags(8) + H5_ITER_N_F = H5generic_flags(9) + + HADDR_UNDEF_F = H5generic_haddr_flags(1) + ! + ! H5G flags + ! + H5G_UNKNOWN_F = H5G_flags(1) + H5G_GROUP_F = H5G_flags(2) + H5G_DATASET_F = H5G_flags(3) + H5G_TYPE_F = H5G_flags(4) + H5G_SAME_LOC_F = H5G_flags(5) + H5G_LINK_ERROR_F = H5G_flags(6) + H5G_LINK_HARD_F = H5G_flags(7) + H5G_LINK_SOFT_F = H5G_flags(8) + H5G_STORAGE_TYPE_UNKNOWN_F = H5G_flags(9) + H5G_STORAGE_TYPE_SYMBOL_TABLE_F = H5G_flags(10) + H5G_STORAGE_TYPE_COMPACT_F = H5G_flags(11) + H5G_STORAGE_TYPE_DENSE_F = H5G_flags(12) + ! + ! H5D flags + ! + H5D_COMPACT_F = H5D_flags(1) + H5D_CONTIGUOUS_F = H5D_flags(2) + H5D_CHUNKED_F = H5D_flags(3) + H5D_ALLOC_TIME_ERROR_F = H5D_flags(4) + H5D_ALLOC_TIME_DEFAULT_F = H5D_flags(5) + H5D_ALLOC_TIME_EARLY_F = H5D_flags(6) + H5D_ALLOC_TIME_LATE_F = H5D_flags(7) + H5D_ALLOC_TIME_INCR_F = H5D_flags(8) + H5D_SPACE_STS_ERROR_F = H5D_flags(9) + H5D_SPACE_STS_NOT_ALLOCATED_F = H5D_flags(10) + H5D_SPACE_STS_PART_ALLOCATED_F = H5D_flags(11) + H5D_SPACE_STS_ALLOCATED_F = H5D_flags(12) + H5D_FILL_TIME_ERROR_F = H5D_flags(13) + H5D_FILL_TIME_ALLOC_F = H5D_flags(14) + H5D_FILL_TIME_NEVER_F = H5D_flags(15) + H5D_FILL_VALUE_ERROR_F = H5D_flags(16) + H5D_FILL_VALUE_UNDEFINED_F = H5D_flags(17) + H5D_FILL_VALUE_DEFAULT_F = H5D_flags(18) + H5D_FILL_VALUE_USER_DEFINED_F = H5D_flags(19) + H5D_CHUNK_CACHE_W0_DFLT_F = H5D_flags(20) + H5D_MPIO_NO_COLLECTIVE_F = H5D_flags(21) + H5D_MPIO_CHUNK_INDEPENDENT_F = H5D_flags(22) + H5D_MPIO_CHUNK_COLLECTIVE_F = H5D_flags(23) + H5D_MPIO_CHUNK_MIXED_F = H5D_flags(24) + H5D_MPIO_CONTIG_COLLECTIVE_F = H5D_flags(25) + H5D_VDS_ERROR_F = H5D_flags(26) + H5D_VDS_FIRST_MISSING_F = H5D_flags(27) + H5D_VDS_LAST_AVAILABLE_F = H5D_flags(28) + H5D_VIRTUAL_F = H5D_flags(29) + + H5D_CHUNK_CACHE_NSLOTS_DFLT_F = H5D_size_flags(1) + H5D_CHUNK_CACHE_NBYTES_DFLT_F = H5D_size_flags(2) + ! + ! H5E flags + ! + H5E_DEFAULT_F = H5E_hid_flags(1) + + H5E_MAJOR_F = H5E_flags(1) + H5E_MINOR_F = H5E_flags(2) + H5E_WALK_UPWARD_F = H5E_flags(3) + H5E_WALK_DOWNWARD_F = H5E_flags(4) + ! + ! H5FD flags + ! + H5FD_MPIO_INDEPENDENT_F = H5FD_flags(1) + H5FD_MPIO_COLLECTIVE_F = H5FD_flags(2) + H5FD_MEM_NOLIST_F = H5FD_flags(3) + H5FD_MEM_DEFAULT_F = H5FD_flags(4) + H5FD_MEM_SUPER_F = H5FD_flags(5) + H5FD_MEM_BTREE_F = H5FD_flags(6) + H5FD_MEM_DRAW_F = H5FD_flags(7) + H5FD_MEM_GHEAP_F = H5FD_flags(8) + H5FD_MEM_LHEAP_F = H5FD_flags(9) + H5FD_MEM_OHDR_F = H5FD_flags(10) + H5FD_MEM_NTYPES_F = H5FD_flags(11) + ! + ! H5FD file driver flags + ! + H5FD_CORE_F = H5FD_hid_flags(1) + H5FD_FAMILY_F = H5FD_hid_flags(2) + H5FD_LOG_F = H5FD_hid_flags(3) + H5FD_MPIO_F = H5FD_hid_flags(4) + H5FD_MULTI_F = H5FD_hid_flags(5) + H5FD_SEC2_F = H5FD_hid_flags(6) + H5FD_STDIO_F = H5FD_hid_flags(7) + ! + ! H5I flags declaration + ! + H5I_FILE_F = H5I_flags(1) + H5I_GROUP_F = H5I_flags(2) + H5I_DATATYPE_F = H5I_flags(3) + H5I_DATASPACE_F = H5I_flags(4) + H5I_DATASET_F = H5I_flags(5) + H5I_ATTR_F = H5I_flags(6) + H5I_BADID_F = H5I_flags(7) + H5I_UNINIT_F = H5I_flags(8) + H5I_VFL_F = H5I_flags(9) + H5I_VOL_F = H5I_flags(10) + H5I_GENPROP_CLS_F = H5I_flags(11) + H5I_GENPROP_LST_F = H5I_flags(12) + H5I_ERROR_CLASS_F = H5I_flags(13) + H5I_ERROR_MSG_F = H5I_flags(14) + H5I_ERROR_STACK_F = H5I_flags(15) + H5I_NTYPES_F = H5I_flags(16) + H5I_INVALID_HID_F = H5I_flags(17) + ! + ! H5L flags + ! + H5L_TYPE_ERROR_F = H5L_flags(1) + H5L_TYPE_HARD_F = H5L_flags(2) + H5L_TYPE_SOFT_F = H5L_flags(3) + H5L_TYPE_EXTERNAL_F = H5L_flags(4) + H5L_SAME_LOC_F = H5L_flags(5) + H5L_LINK_CLASS_T_VERS_F = H5L_flags(6) + ! + ! H5O flags + ! + H5O_COPY_SHALLOW_HIERARCHY_F = h5o_flags(1) + H5O_COPY_EXPAND_SOFT_LINK_F = h5o_flags(2) + H5O_COPY_EXPAND_EXT_LINK_F = h5o_flags(3) + H5O_COPY_EXPAND_REFERENCE_F = h5o_flags(4) + H5O_COPY_WITHOUT_ATTR_FLAG_F = h5o_flags(5) + H5O_COPY_PRESERVE_NULL_FLAG_F = h5o_flags(6) + H5O_COPY_ALL_F = h5o_flags(7) + H5O_SHMESG_NONE_FLAG_F = h5o_flags(8) + H5O_SHMESG_SDSPACE_FLAG_F = h5o_flags(9) + H5O_SHMESG_DTYPE_FLAG_F = h5o_flags(10) + H5O_SHMESG_FILL_FLAG_F = h5o_flags(11) + H5O_SHMESG_PLINE_FLAG_F = h5o_flags(12) + H5O_SHMESG_ATTR_FLAG_F = h5o_flags(13) + H5O_SHMESG_ALL_FLAG_F = h5o_flags(14) + H5O_HDR_CHUNK0_SIZE_F = h5o_flags(15) + H5O_HDR_ATTR_CRT_ORDER_TRACK_F = h5o_flags(16) + H5O_HDR_ATTR_CRT_ORDER_INDEX_F = h5o_flags(17) + H5O_HDR_ATTR_STORE_PHASE_CHA_F = h5o_flags(18) + H5O_HDR_STORE_TIMES_F = h5o_flags(19) + H5O_HDR_ALL_FLAGS_F = h5o_flags(20) + H5O_SHMESG_MAX_NINDEXES_F = h5o_flags(21) + H5O_SHMESG_MAX_LIST_SIZE_F = h5o_flags(22) + H5O_TYPE_UNKNOWN_F = h5o_flags(23) + H5O_TYPE_GROUP_F = h5o_flags(24) + H5O_TYPE_DATASET_F = h5o_flags(25) + H5O_TYPE_NAMED_DATATYPE_F = h5o_flags(26) + H5O_TYPE_NTYPES_F = h5o_flags(27) + H5O_INFO_ALL_F = h5o_flags(28) + H5O_INFO_BASIC_F = h5o_flags(29) + H5O_INFO_TIME_F = h5o_flags(30) + H5O_INFO_NUM_ATTRS_F = h5o_flags(31) + H5O_INFO_HDR_F = h5o_flags(32) + H5O_INFO_META_SIZE_F = h5o_flags(33) + ! + ! H5P flags + ! + H5P_FILE_CREATE_F = H5P_flags(1) + H5P_FILE_ACCESS_F = H5P_flags(2) + H5P_DATASET_CREATE_F = H5P_flags(3) + H5P_DATASET_XFER_F = H5P_flags(4) + H5P_FILE_MOUNT_F = H5P_flags(5) + H5P_DEFAULT_F = H5P_flags(6) + H5P_ROOT_F = H5P_flags(7) + H5P_OBJECT_CREATE_F = H5P_flags(8) + H5P_DATASET_ACCESS_F = H5P_flags(9) + H5P_GROUP_CREATE_F = H5P_flags(10) + H5P_GROUP_ACCESS_F = H5P_flags(11) + H5P_DATATYPE_CREATE_F = H5P_flags(12) + H5P_DATATYPE_ACCESS_F = H5P_flags(13) + H5P_STRING_CREATE_F = H5P_flags(14) + H5P_ATTRIBUTE_CREATE_F = H5P_flags(15) + H5P_OBJECT_COPY_F = H5P_flags(16) + H5P_LINK_CREATE_F = H5P_flags(17) + H5P_LINK_ACCESS_F = H5P_flags(18) + ! + ! H5P integers flags + ! + H5P_CRT_ORDER_INDEXED_F = H5P_flags_int(1) + H5P_CRT_ORDER_TRACKED_F = H5P_flags_int(2) + ! + ! H5R flags + ! + H5R_OBJECT_F = H5R_flags(1) + H5R_DATASET_REGION_F = H5R_flags(2) + ! + ! H5S flags + ! + H5S_ALL_F = H5S_hid_flags(1) + + H5S_UNLIMITED_F = H5S_hsize_flags(1) + + H5S_SCALAR_F = H5S_flags(1) + H5S_SIMPLE_F = H5S_flags(2) + H5S_NULL_F = H5S_flags(3) + H5S_SELECT_SET_F = H5S_flags(4) + H5S_SELECT_OR_F = H5S_flags(5) + H5S_SELECT_NOOP_F = H5S_flags(6) + H5S_SELECT_AND_F = H5S_flags(7) + H5S_SELECT_XOR_F = H5S_flags(8) + H5S_SELECT_NOTB_F = H5S_flags(9) + H5S_SELECT_NOTA_F = H5S_flags(10) + H5S_SELECT_APPEND_F = H5S_flags(11) + H5S_SELECT_PREPEND_F = H5S_flags(12) + H5S_SELECT_INVALID_F = H5S_flags(13) + H5S_SEL_ERROR_F = H5S_flags(14) + H5S_SEL_NONE_F = H5S_flags(15) + H5S_SEL_POINTS_F = H5S_flags(16) + H5S_SEL_HYPERSLABS_F = H5S_flags(17) + H5S_SEL_ALL_F = H5S_flags(18) + ! + ! H5T flags declaration + ! + H5T_NO_CLASS_F = H5T_flags(1) + H5T_INTEGER_F = H5T_flags(2) + H5T_FLOAT_F = H5T_flags(3) + H5T_TIME_F = H5T_flags(4) + H5T_STRING_F = H5T_flags(5) + H5T_BITFIELD_F = H5T_flags(6) + H5T_OPAQUE_F = H5T_flags(7) + H5T_COMPOUND_F = H5T_flags(8) + H5T_REFERENCE_F = H5T_flags(9) + H5T_ENUM_F = H5T_flags(10) + H5T_ORDER_LE_F = H5T_flags(11) + H5T_ORDER_BE_F = H5T_flags(12) + H5T_ORDER_MIXED_F = H5T_flags(13) + H5T_ORDER_VAX_F = H5T_flags(14) + H5T_ORDER_NONE_F = H5T_flags(15) + H5T_PAD_ZERO_F = H5T_flags(16) + H5T_PAD_ONE_F = H5T_flags(17) + H5T_PAD_BACKGROUND_F = H5T_flags(18) + H5T_PAD_ERROR_F = H5T_flags(19) + H5T_SGN_NONE_F = H5T_flags(20) + H5T_SGN_2_F = H5T_flags(21) + H5T_SGN_ERROR_F = H5T_flags(22) + H5T_NORM_IMPLIED_F = H5T_flags(23) + H5T_NORM_MSBSET_F = H5T_flags(24) + H5T_NORM_NONE_F = H5T_flags(25) + H5T_CSET_ASCII_F = H5T_flags(26) + H5T_CSET_UTF8_F = H5T_flags(27) + H5T_STR_NULLTERM_F = H5T_flags(28) + H5T_STR_NULLPAD_F = H5T_flags(29) + H5T_STR_SPACEPAD_F = H5T_flags(30) + H5T_STR_ERROR_F = H5T_flags(31) + H5T_VLEN_F = H5T_flags(32) + H5T_ARRAY_F = H5T_flags(33) + H5T_DIR_ASCEND_F = H5T_flags(34) + H5T_DIR_DESCEND_F = H5T_flags(35) + ! + ! H5Z flags + ! + H5Z_FILTER_ERROR_F = H5Z_flags(1) + H5Z_FILTER_NONE_F = H5Z_flags(2) + H5Z_FILTER_DEFLATE_F = H5Z_flags(3) + H5Z_FILTER_SHUFFLE_F = H5Z_flags(4) + H5Z_FILTER_FLETCHER32_F = H5Z_flags(5) + H5Z_ERROR_EDC_F = H5Z_flags(6) + H5Z_DISABLE_EDC_F = H5Z_flags(7) + H5Z_ENABLE_EDC_F = H5Z_flags(8) + H5Z_NO_EDC_F = H5Z_flags(9) + H5Z_FILTER_SZIP_F = H5Z_flags(10) + H5Z_FLAG_OPTIONAL_F = H5Z_flags(11) + H5Z_FILTER_ENCODE_ENABLED_F = H5Z_flags(12) + H5Z_FILTER_DECODE_ENABLED_F = H5Z_flags(13) + H5Z_FILTER_ALL_F = H5Z_flags(14) + H5Z_FILTER_NBIT_F = H5Z_flags(15) + H5Z_FILTER_SCALEOFFSET_F = H5Z_flags(16) + H5Z_SO_FLOAT_DSCALE_F = H5Z_flags(17) + H5Z_SO_FLOAT_ESCALE_F = H5Z_flags(18) + H5Z_SO_INT_F = H5Z_flags(19) + H5Z_SO_INT_MINBITS_DEFAULT_F = H5Z_flags(20) + + error = error + h5init1_flags_c(H5LIB_flags) + ! + ! H5 Library flags + ! + H5_SZIP_EC_OM_F = H5LIB_flags(1) + H5_SZIP_NN_OM_F = H5LIB_flags(2) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, H5OPEN_NUM_OBJ_LOC, error) + + H5OPEN_NUM_OBJ = H5OPEN_NUM_OBJ_LOC + END SUBROUTINE h5open_f !****s* H5LIB/h5close_f @@ -201,25 +671,23 @@ CONTAINS IMPLICIT NONE INTEGER, INTENT(OUT) :: error !***** - INTEGER :: error_1 INTERFACE INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & f_types, F_TYPES_LEN, & i_types, I_TYPES_LEN ) & BIND(C,NAME='h5close_types_c') IMPORT :: HID_T - INTEGER P_TYPES_LEN - INTEGER F_TYPES_LEN - INTEGER I_TYPES_LEN - INTEGER(HID_T), DIMENSION(P_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(F_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(I_TYPES_LEN) :: i_types + INTEGER :: P_TYPES_LEN + INTEGER :: F_TYPES_LEN + INTEGER :: I_TYPES_LEN + INTEGER(HID_T), DIMENSION(1:P_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(1:F_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(1:I_TYPES_LEN) :: i_types END FUNCTION h5close_types_c END INTERFACE - error_1 = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & + error = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & floating_types, FLOATING_TYPES_LEN, & integer_types, INTEGER_TYPES_LEN ) - error = error_1 END SUBROUTINE h5close_f @@ -453,4 +921,62 @@ CONTAINS END FUNCTION h5offsetof +!****f* H5LIB_PROVISIONAL/h5gmtime +! +! NAME +! h5gmtime +! +! PURPOSE +! Convert time_t structure (C) to Fortran DATE AND TIME storage format. +! +! Inputs: +! stdtime_t - Object of type time_t that contains a time value +! +! Outputs: +! datetime - A date/time array using Fortran conventions: +! datetime(1) = year +! datetime(2) = month +! datetime(3) = day +! datetime(4) = 0 ! time is expressed as UTC (or GMT timezone) */ +! datetime(5) = hour +! datetime(6) = minute +! datetime(7) = second +! datetime(8) = millisecond -- not available, assigned - HUGE(0) +! +! AUTHOR +! M. Scot Breitenfeld +! January, 2019 +! +! Fortran Interface: + FUNCTION h5gmtime(stdtime_t) + IMPLICIT NONE + INTEGER(KIND=TIME_T), INTENT(IN) :: stdtime_t + INTEGER, DIMENSION(1:8) :: h5gmtime +!***** + TYPE(C_PTR) :: cptr + INTEGER(C_INT), DIMENSION(:), POINTER :: c_time + + INTERFACE + FUNCTION gmtime(stdtime_t) BIND(C, NAME='gmtime') + IMPORT :: TIME_T, C_PTR + IMPLICIT NONE + INTEGER(KIND=TIME_T) :: stdtime_t + TYPE(C_PTR) :: gmtime + END FUNCTION gmtime + END INTERFACE + + cptr = gmtime(stdtime_t) + CALL C_F_POINTER(cptr, c_time, [9]) + + h5gmtime(1) = INT(c_time(6)+1900) ! year starts at 1900 + h5gmtime(2) = INT(c_time(5)+1) ! month starts at 0 in C + h5gmtime(3) = INT(c_time(4)) ! day + h5gmtime(4) = 0 ! time is expressed as UTC (or GMT timezone) + h5gmtime(5) = INT(c_time(3)) ! hour + h5gmtime(6) = INT(c_time(2)) ! minute + h5gmtime(7) = INT(c_time(1)) ! second + h5gmtime(8) = -32767 ! millisecond is not available, assign it -HUGE(0) + + END FUNCTION h5gmtime + END MODULE H5LIB diff --git a/fortran/src/H5config_f.inc.cmake b/fortran/src/H5config_f.inc.cmake index f85db6c..3dd3c8c 100644 --- a/fortran/src/H5config_f.inc.cmake +++ b/fortran/src/H5config_f.inc.cmake @@ -12,87 +12,61 @@ ! fortran/src/H5config_f.inc. Generated from fortran/src/H5config_f.inc.in by configure ! Define if we have parallel support -#define H5_HAVE_PARALLEL @CMAKE_H5_HAVE_PARALLEL@ - -#if H5_HAVE_PARALLEL==0 +#cmakedefine01 H5_HAVE_PARALLEL +#if H5_HAVE_PARALLEL == 0 #undef H5_HAVE_PARALLEL #endif ! Define if the intrinsic function STORAGE_SIZE exists -#define H5_FORTRAN_HAVE_STORAGE_SIZE @FORTRAN_HAVE_STORAGE_SIZE@ - -#if H5_FORTRAN_HAVE_STORAGE_SIZE==0 -#undef H5_FORTRAN_HAVE_STORAGE_SIZE -#endif +#define H5_FORTRAN_HAVE_STORAGE_SIZE @H5_FORTRAN_HAVE_STORAGE_SIZE@ ! Define if the intrinsic function SIZEOF exists -#define H5_FORTRAN_HAVE_SIZEOF @FORTRAN_HAVE_SIZEOF@ - -#if H5_FORTRAN_HAVE_SIZEOF==0 -#undef H5_FORTRAN_HAVE_SIZEOF -#endif +#define H5_FORTRAN_HAVE_SIZEOF @H5_FORTRAN_HAVE_SIZEOF@ ! Define if the intrinsic function C_SIZEOF exists -#define H5_FORTRAN_HAVE_C_SIZEOF @FORTRAN_HAVE_C_SIZEOF@ - -#if H5_FORTRAN_HAVE_C_SIZEOF==0 -#undef H5_FORTRAN_HAVE_C_SIZEOF -#endif +#define H5_FORTRAN_HAVE_C_SIZEOF @H5_FORTRAN_HAVE_C_SIZEOF@ ! Define if the intrinsic C_LONG_DOUBLE exists -#define H5_FORTRAN_HAVE_C_LONG_DOUBLE @FORTRAN_HAVE_C_LONG_DOUBLE@ - -#if H5_FORTRAN_HAVE_C_LONG_DOUBLE==0 -#undef H5_FORTRAN_HAVE_C_LONG_DOUBLE -#endif +#define H5_FORTRAN_HAVE_C_LONG_DOUBLE @H5_FORTRAN_HAVE_C_LONG_DOUBLE@ ! Define if Fortran C_LONG_DOUBLE is different from C_DOUBLE -#define H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE @FORTRAN_C_LONG_DOUBLE_IS_UNIQUE@ +#define H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE @H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE@ ! Define if the intrinsic module ISO_FORTRAN_ENV exists -#define H5_HAVE_ISO_FORTRAN_ENV @HAVE_ISO_FORTRAN_ENV@ - +#define H5_HAVE_ISO_FORTRAN_ENV @H5_HAVE_ISO_FORTRAN_ENV@ ! should this be ${HDF_PREFIX} instead of H5 MSB #define H5_SIZEOF_DOUBLE @H5_SIZEOF_DOUBLE@ -#if H5_SIZEOF_DOUBLE==0 -#undef H5_SIZEOF_DOUBLE -#endif - ! should this be ${HDF_PREFIX} instead of H5 MSB #define H5_SIZEOF_LONG_DOUBLE @H5_SIZEOF_LONG_DOUBLE@ -#if H5_SIZEOF_LONG_DOUBLE==0 -#undef H5_SIZEOF_LONG_DOUBLE -#endif - ! Define the maximum decimal precision for reals #define H5_PAC_FC_MAX_REAL_PRECISION @H5_PAC_FC_MAX_REAL_PRECISION@ ! If C has quad precision #define H5_HAVE_FLOAT128 @H5_HAVE_FLOAT128@ -! Define if INTEGER*16 is available -#define H5_HAVE_Fortran_INTEGER_SIZEOF_16 @HAVE_Fortran_INTEGER_SIZEOF_16@ +! Define if INTEGER*16 is available +#define H5_HAVE_Fortran_INTEGER_SIZEOF_16 @H5_HAVE_Fortran_INTEGER_SIZEOF_16@ ! Maximum decimal precision for C #define H5_PAC_C_MAX_REAL_PRECISION @H5_PAC_C_MAX_REAL_PRECISION@ ! number of valid REAL KINDs -#define H5_H5CONFIG_F_NUM_RKIND @H5CONFIG_F_NUM_RKIND@ +#define H5_H5CONFIG_F_NUM_RKIND @H5_H5CONFIG_F_NUM_RKIND@ ! valid REAL KINDs (need to have a matching C counter-part) -#define H5_H5CONFIG_F_RKIND @H5CONFIG_F_RKIND@ +#define H5_H5CONFIG_F_RKIND @H5_H5CONFIG_F_RKIND@ ! valid REAL KINDs (need to have a matching C counter-part) -#define H5_H5CONFIG_F_RKIND_SIZEOF @H5CONFIG_F_RKIND_SIZEOF@ +#define H5_H5CONFIG_F_RKIND_SIZEOF @H5_H5CONFIG_F_RKIND_SIZEOF@ ! number of valid INTEGER KINDs -#define H5_H5CONFIG_F_NUM_IKIND @H5CONFIG_F_NUM_IKIND@ +#define H5_H5CONFIG_F_NUM_IKIND @H5_H5CONFIG_F_NUM_IKIND@ ! valid INTEGER KINDs (need to have a matching C counter-part) -#define H5_H5CONFIG_F_IKIND @H5CONFIG_F_IKIND@ +#define H5_H5CONFIG_F_IKIND @H5_H5CONFIG_F_IKIND@ ! Fortran compiler id -#define H5_Fortran_COMPILER_ID @Fortran_COMPILER_ID@ +#define H5_Fortran_COMPILER_ID @CMAKE_Fortran_COMPILER_ID@ diff --git a/fortran/src/H5config_f.inc.in b/fortran/src/H5config_f.inc.in index 8921493..71eb936 100644 --- a/fortran/src/H5config_f.inc.in +++ b/fortran/src/H5config_f.inc.in @@ -12,7 +12,7 @@ ! fortran/src/H5config_f.inc. Generated from fortran/src/H5config_f.inc.in by configure ! The script to replace the defines in H5config_f.inc.in is -! located in configure.ac in the Fortran section. +! located in configure.ac in the Fortran section. ! Define if we have parallel support #undef HAVE_PARALLEL @@ -47,7 +47,7 @@ ! If C has quad precision #undef HAVE_FLOAT128 -! Define if INTEGER*16 is available +! Define if INTEGER*16 is available #undef HAVE_Fortran_INTEGER_SIZEOF_16 ! Maximum decimal precision for C diff --git a/fortran/src/H5f90.h b/fortran/src/H5f90.h index eabe3d0..655cb9b 100644 --- a/fortran/src/H5f90.h +++ b/fortran/src/H5f90.h @@ -25,5 +25,8 @@ /* Constants used in H5Gf.c files */ #define OBJECT_NAMELEN_DEFAULT_F -1 + #define H5_MAX(a,b) (((a)>(b)) ? (a) : (b)) + #endif /* _H5f90_H */ + diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index dd2b171..8cf601e 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -49,12 +49,12 @@ MODULE H5GLOBAL ENUMERATOR :: enum_dtype END ENUM INTEGER, PARAMETER :: ENUM_T = KIND(enum_dtype) - ! Definitions for reference datatypes. ! If you change the value of these parameters, do not forget to change corresponding ! values in the H5f90.h file. INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER, PARAMETER :: H5O_TOKEN_BUF_LEN = 16 ! Matches C defined value in H5public.h ! Parameters used in the function 'h5kind_to_type' located in H5_ff.F90. ! The flag is used to tell the function whether the kind input variable @@ -71,186 +71,179 @@ MODULE H5GLOBAL INTEGER, DIMENSION(1:REF_REG_BUF_LEN) :: ref END TYPE hdset_reg_ref_t_f - INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 19 ! Do not forget to change this - ! value when new predefined - ! datatypes are added + TYPE, BIND(C) :: h5o_token_t_f + INTEGER(C_INT8_T), DIMENSION(1:H5O_TOKEN_BUF_LEN) :: token + END TYPE h5o_token_t_f - ! Do not forget to change the following line when new predefined - ! floating data types are added + ! Do not forget to change these values when new predefined + ! datatypes are added + INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 19 INTEGER, PARAMETER :: FLOATING_TYPES_LEN = 4 - - ! Do not forget to change the following line when new predefined - ! integer data types are added INTEGER, PARAMETER :: INTEGER_TYPES_LEN = 27 - INTEGER(HID_T) :: H5T_NATIVE_REAL_C_FLOAT, & - H5T_NATIVE_REAL_C_DOUBLE, & - H5T_NATIVE_REAL_C_LONG_DOUBLE, & - H5T_NATIVE_INTEGER, & - H5T_NATIVE_REAL, & - H5T_NATIVE_DOUBLE, & - H5T_NATIVE_CHARACTER , & - H5T_STD_REF_OBJ, & - H5T_STD_REF_DSETREG, & - H5T_IEEE_F32BE, & - H5T_IEEE_F32LE, & - H5T_IEEE_F64BE, & - H5T_IEEE_F64LE, & - H5T_STD_I8BE, & - H5T_STD_I8LE, & - H5T_STD_I16BE, & - H5T_STD_I16LE, & - H5T_STD_I32BE, & - H5T_STD_I32LE, & - H5T_STD_I64BE, & - H5T_STD_I64LE, & - H5T_STD_U8BE, & - H5T_STD_U8LE, & - H5T_STD_U16BE, & - H5T_STD_U16LE, & - H5T_STD_U32BE + ! These arrays need to be global because they are used in + ! both h5open_f and in h5close_f; initialize to fix linking issues + ! on OSX and Intel compilers. + INTEGER(HID_T), DIMENSION(1:PREDEF_TYPES_LEN) :: predef_types = -1 + INTEGER(HID_T), DIMENSION(1:FLOATING_TYPES_LEN) :: floating_types = -1 + INTEGER(HID_T), DIMENSION(1:INTEGER_TYPES_LEN) :: integer_types = -1 + + !DEC$if defined(BUILD_HDF5_DLL) + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_REAL_C_FLOAT + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_REAL_C_DOUBLE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_REAL_C_LONG_DOUBLE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_INTEGER + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_REAL + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_DOUBLE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_CHARACTER + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_REF_OBJ + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_REF_DSETREG + !DEC$ATTRIBUTES DLLEXPORT :: H5T_IEEE_F32BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_IEEE_F32LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_IEEE_F64BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_IEEE_F64LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I8BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I8LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I16BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I16LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I32BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I32LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I64BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_I64LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U8BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U8LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U16BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U16LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U32BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U32LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U64BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_U64LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STRING + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B8BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B8LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B16BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B16LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B32BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B32LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B64BE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STD_B64LE + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_B8 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_B16 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_B32 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_B64 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_FORTRAN_S1 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_C_S1 + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_INTEGER_KIND + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NATIVE_FLOAT_128 + !DEC$endif + + INTEGER(HID_T) :: H5T_NATIVE_REAL_C_FLOAT + INTEGER(HID_T) :: H5T_NATIVE_REAL_C_DOUBLE + INTEGER(HID_T) :: H5T_NATIVE_REAL_C_LONG_DOUBLE + INTEGER(HID_T) :: H5T_NATIVE_INTEGER + INTEGER(HID_T) :: H5T_NATIVE_REAL + INTEGER(HID_T) :: H5T_NATIVE_DOUBLE + INTEGER(HID_T) :: H5T_NATIVE_CHARACTER + INTEGER(HID_T) :: H5T_STD_REF_OBJ + INTEGER(HID_T) :: H5T_STD_REF_DSETREG + INTEGER(HID_T) :: H5T_IEEE_F32BE + INTEGER(HID_T) :: H5T_IEEE_F32LE + INTEGER(HID_T) :: H5T_IEEE_F64BE + INTEGER(HID_T) :: H5T_IEEE_F64LE + INTEGER(HID_T) :: H5T_STD_I8BE + INTEGER(HID_T) :: H5T_STD_I8LE + INTEGER(HID_T) :: H5T_STD_I16BE + INTEGER(HID_T) :: H5T_STD_I16LE + INTEGER(HID_T) :: H5T_STD_I32BE + INTEGER(HID_T) :: H5T_STD_I32LE + INTEGER(HID_T) :: H5T_STD_I64BE + INTEGER(HID_T) :: H5T_STD_I64LE + INTEGER(HID_T) :: H5T_STD_U8BE + INTEGER(HID_T) :: H5T_STD_U8LE + INTEGER(HID_T) :: H5T_STD_U16BE + INTEGER(HID_T) :: H5T_STD_U16LE + INTEGER(HID_T) :: H5T_STD_U32BE + INTEGER(HID_T) :: H5T_STD_U32LE + INTEGER(HID_T) :: H5T_STD_U64BE + INTEGER(HID_T) :: H5T_STD_U64LE + INTEGER(HID_T) :: H5T_STRING + INTEGER(HID_T) :: H5T_STD_B8BE + INTEGER(HID_T) :: H5T_STD_B8LE + INTEGER(HID_T) :: H5T_STD_B16BE + INTEGER(HID_T) :: H5T_STD_B16LE + INTEGER(HID_T) :: H5T_STD_B32BE + INTEGER(HID_T) :: H5T_STD_B32LE + INTEGER(HID_T) :: H5T_STD_B64BE + INTEGER(HID_T) :: H5T_STD_B64LE + INTEGER(HID_T) :: H5T_NATIVE_B8 + INTEGER(HID_T) :: H5T_NATIVE_B16 + INTEGER(HID_T) :: H5T_NATIVE_B32 + INTEGER(HID_T) :: H5T_NATIVE_B64 + INTEGER(HID_T) :: H5T_FORTRAN_S1 + INTEGER(HID_T) :: H5T_C_S1 INTEGER, PARAMETER :: NUM_NATIVE_INTEGER_KIND = 5 ! INTEGER*1, INTEGER*2, INTEGER*4, INTEGER*8, INTEGER*16 INTEGER(HID_T), DIMENSION(1:NUM_NATIVE_INTEGER_KIND) :: H5T_NATIVE_INTEGER_KIND INTEGER(HID_T) :: H5T_NATIVE_FLOAT_128 ! NEED IFDEF -MSB- - -! NOTE: Splitting the line since the Fortran 95 standard limits the number of -! continuation lines to 39; the F03/F08 standard limits the number -! to 255 lines. - - INTEGER(HID_T) :: H5T_STD_U32LE, & - H5T_STD_U64BE, & - H5T_STD_U64LE, & - H5T_STRING, & - H5T_STD_B8BE, & - H5T_STD_B8LE, & - H5T_STD_B16BE, & - H5T_STD_B16LE, & - H5T_STD_B32BE, & - H5T_STD_B32LE, & - H5T_STD_B64BE, & - H5T_STD_B64LE, & - H5T_NATIVE_B8, & - H5T_NATIVE_B16, & - H5T_NATIVE_B32, & - H5T_NATIVE_B64, & - H5T_FORTRAN_S1, & - H5T_C_S1 - - - INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: predef_types - EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER_KIND(1)) - EQUIVALENCE (predef_types(2), H5T_NATIVE_INTEGER_KIND(2)) - EQUIVALENCE (predef_types(3), H5T_NATIVE_INTEGER_KIND(3)) - EQUIVALENCE (predef_types(4), H5T_NATIVE_INTEGER_KIND(4)) - EQUIVALENCE (predef_types(5), H5T_NATIVE_INTEGER_KIND(5)) - EQUIVALENCE (predef_types(6), H5T_NATIVE_INTEGER) - EQUIVALENCE (predef_types(7), H5T_NATIVE_REAL) - EQUIVALENCE (predef_types(8), H5T_NATIVE_DOUBLE) - EQUIVALENCE (predef_types(9), H5T_NATIVE_CHARACTER) - EQUIVALENCE (predef_types(10), H5T_STD_REF_OBJ) - EQUIVALENCE (predef_types(11), H5T_STD_REF_DSETREG) - EQUIVALENCE (predef_types(12), H5T_NATIVE_REAL_C_FLOAT) - EQUIVALENCE (predef_types(13), H5T_NATIVE_REAL_C_DOUBLE) - EQUIVALENCE (predef_types(14), H5T_NATIVE_REAL_C_LONG_DOUBLE) - EQUIVALENCE (predef_types(15), H5T_NATIVE_B8 ) - EQUIVALENCE (predef_types(16), H5T_NATIVE_B16) - EQUIVALENCE (predef_types(17), H5T_NATIVE_B32) - EQUIVALENCE (predef_types(18), H5T_NATIVE_B64) - EQUIVALENCE (predef_types(19), H5T_NATIVE_FLOAT_128) ! ADDED NEW TYPE -MSB- - - INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: floating_types - EQUIVALENCE (floating_types(1), H5T_IEEE_F32BE ) - EQUIVALENCE (floating_types(2), H5T_IEEE_F32LE) - EQUIVALENCE (floating_types(3), H5T_IEEE_F64BE) - EQUIVALENCE (floating_types(4), H5T_IEEE_F64LE) - - INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: integer_types - EQUIVALENCE (integer_types(1), H5T_STD_I8BE ) - EQUIVALENCE (integer_types(2), H5T_STD_I8LE) - EQUIVALENCE (integer_types(3), H5T_STD_I16BE) - EQUIVALENCE (integer_types(4), H5T_STD_I16LE) - EQUIVALENCE (integer_types(5), H5T_STD_I32BE) - EQUIVALENCE (integer_types(6), H5T_STD_I32LE) - EQUIVALENCE (integer_types(7), H5T_STD_I64BE) - EQUIVALENCE (integer_types(8), H5T_STD_I64LE) - EQUIVALENCE (integer_types(9), H5T_STD_U8BE) - EQUIVALENCE (integer_types(10), H5T_STD_U8LE) - EQUIVALENCE (integer_types(11), H5T_STD_U16BE) - EQUIVALENCE (integer_types(12), H5T_STD_U16LE) - EQUIVALENCE (integer_types(13), H5T_STD_U32BE) - EQUIVALENCE (integer_types(14), H5T_STD_U32LE) - EQUIVALENCE (integer_types(15), H5T_STD_U64BE) - EQUIVALENCE (integer_types(16), H5T_STD_U64LE) - EQUIVALENCE (integer_types(17), H5T_STRING) - EQUIVALENCE (integer_types(18), H5T_STD_B8BE) - EQUIVALENCE (integer_types(19), H5T_STD_B8LE) - EQUIVALENCE (integer_types(20), H5T_STD_B16BE) - EQUIVALENCE (integer_types(21), H5T_STD_B16LE) - EQUIVALENCE (integer_types(22), H5T_STD_B32BE) - EQUIVALENCE (integer_types(23), H5T_STD_B32LE) - EQUIVALENCE (integer_types(24), H5T_STD_B64BE) - EQUIVALENCE (integer_types(25), H5T_STD_B64LE) - EQUIVALENCE (integer_types(26), H5T_FORTRAN_S1) - EQUIVALENCE (integer_types(27), H5T_C_S1) - - - ! COMMON /PREDEFINED_TYPES/ H5T_NATIVE_INTEGER, & - ! H5T_NATIVE_REAL, & - ! H5T_NATIVE_DOUBLE, & - ! H5T_NATIVE_CHARACTER, & - ! H5T_STD_REF_OBJ, & - ! H5T_STD_REF_DSETREG - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /PREDEFINED_TYPES/ - !DEC$endif - COMMON /PREDEFINED_TYPES/ predef_types - - ! COMMON /FLOATING_TYPES/ H5T_IEEE_F32BE, & - ! H5T_IEEE_F32LE, & - ! H5T_IEEE_F64BE, & - ! H5T_IEEE_F64LE - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /FLOATING_TYPES/ - !DEC$endif - COMMON /FLOATING_TYPES/ floating_types ! - ! COMMON /INTEGER_TYPES/ H5T_STD_I8BE, & - ! H5T_STD_I8LE, & - ! H5T_STD_I16BE, & - ! H5T_STD_I16LE, & - ! H5T_STD_I32BE, & - ! H5T_STD_I32LE, & - ! H5T_STD_I64BE, & - ! H5T_STD_I64LE, & - ! H5T_STD_U8BE, & - ! H5T_STD_U8LE, & - ! H5T_STD_U16BE, & - ! H5T_STD_U16LE, & - ! H5T_STD_U32BE, & - ! H5T_STD_U32LE, & - ! H5T_STD_U64BE, & - ! H5T_STD_U64LE + ! H5generic flags declaration + ! !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /INTEGER_TYPES/ + !DEC$ATTRIBUTES DLLEXPORT :: H5_INDEX_UNKNOWN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_INDEX_NAME_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_INDEX_CRT_ORDER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_INDEX_N_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_ITER_UNKNOWN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_ITER_INC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_ITER_DEC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_ITER_NATIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_ITER_N_F + !DEC$ATTRIBUTES DLLEXPORT :: HADDR_UNDEF_F !DEC$endif - COMMON /INTEGER_TYPES/ integer_types - ! - ! Fortran flags - ! - ! - ! H5F flags (DO NOT FORGET TO UPDATE WHEN NEW FLAGS ARE ADDED !) + + INTEGER :: H5_INDEX_UNKNOWN_F + INTEGER :: H5_INDEX_NAME_F + INTEGER :: H5_INDEX_CRT_ORDER_F + INTEGER :: H5_INDEX_N_F + INTEGER :: H5_ITER_UNKNOWN_F + INTEGER :: H5_ITER_INC_F + INTEGER :: H5_ITER_DEC_F + INTEGER :: H5_ITER_NATIVE_F + INTEGER :: H5_ITER_N_F + + INTEGER(HADDR_T) :: HADDR_UNDEF_F ! ! H5F flags declaration ! - INTEGER, PARAMETER :: H5F_FLAGS_LEN = 19 - INTEGER :: H5F_flags(H5F_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5F_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5F_ACC_RDWR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_ACC_RDONLY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_ACC_TRUNC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_ACC_EXCL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_ACC_DEBUG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_SCOPE_LOCAL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_SCOPE_GLOBAL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_CLOSE_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_CLOSE_WEAK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_CLOSE_SEMI_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_CLOSE_STRONG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_OBJ_FILE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_OBJ_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_OBJ_GROUP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_OBJ_DATATYPE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_OBJ_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_EARLIEST_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_LATEST_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_UNLIMITED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_NBOUNDS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V18_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V110_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V112_F + !DEC$ATTRIBUTES DLLEXPORT :: H5F_LIBVER_V114_F !DEC$endif - COMMON /H5F_FLAGS/ H5F_flags INTEGER :: H5F_ACC_RDWR_F INTEGER :: H5F_ACC_RDONLY_F @@ -271,76 +264,31 @@ MODULE H5GLOBAL INTEGER :: H5F_LIBVER_EARLIEST_F INTEGER :: H5F_LIBVER_LATEST_F INTEGER :: H5F_UNLIMITED_F - - EQUIVALENCE(H5F_flags(1), H5F_ACC_RDWR_F) - EQUIVALENCE(H5F_flags(2), H5F_ACC_RDONLY_F) - EQUIVALENCE(H5F_flags(3), H5F_ACC_TRUNC_F) - EQUIVALENCE(H5F_flags(4), H5F_ACC_EXCL_F) - EQUIVALENCE(H5F_flags(5), H5F_ACC_DEBUG_F) - EQUIVALENCE(H5F_flags(6), H5F_SCOPE_LOCAL_F) - EQUIVALENCE(H5F_flags(7), H5F_SCOPE_GLOBAL_F) - EQUIVALENCE(H5F_flags(8), H5F_CLOSE_DEFAULT_F) - EQUIVALENCE(H5F_flags(9), H5F_CLOSE_WEAK_F) - EQUIVALENCE(H5F_flags(10), H5F_CLOSE_SEMI_F) - EQUIVALENCE(H5F_flags(11), H5F_CLOSE_STRONG_F) - EQUIVALENCE(H5F_flags(12), H5F_OBJ_FILE_F) - EQUIVALENCE(H5F_flags(13), H5F_OBJ_DATASET_F) - EQUIVALENCE(H5F_flags(14), H5F_OBJ_GROUP_F) - EQUIVALENCE(H5F_flags(15), H5F_OBJ_DATATYPE_F) - EQUIVALENCE(H5F_flags(16), H5F_OBJ_ALL_F) - EQUIVALENCE(H5F_flags(17), H5F_LIBVER_EARLIEST_F) - EQUIVALENCE(H5F_flags(18), H5F_LIBVER_LATEST_F) - EQUIVALENCE(H5F_flags(19), H5F_UNLIMITED_F) - ! - ! H5generic flags declaration - ! - INTEGER, PARAMETER :: H5generic_FLAGS_LEN = 9 - INTEGER :: H5generic_flags(H5generic_FLAGS_LEN) - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5generic_FLAGS/ - !DEC$endif - COMMON /H5generic_FLAGS/ H5generic_flags - - INTEGER :: H5_INDEX_UNKNOWN_F - INTEGER :: H5_INDEX_NAME_F - INTEGER :: H5_INDEX_CRT_ORDER_F - INTEGER :: H5_INDEX_N_F - INTEGER :: H5_ITER_UNKNOWN_F - INTEGER :: H5_ITER_INC_F - INTEGER :: H5_ITER_DEC_F - INTEGER :: H5_ITER_NATIVE_F - INTEGER :: H5_ITER_N_F - - EQUIVALENCE(H5generic_flags(1), H5_INDEX_UNKNOWN_F) - EQUIVALENCE(H5generic_flags(2), H5_INDEX_NAME_F) - EQUIVALENCE(H5generic_flags(3), H5_INDEX_CRT_ORDER_F) - EQUIVALENCE(H5generic_flags(4), H5_INDEX_N_F) - EQUIVALENCE(H5generic_flags(5), H5_ITER_UNKNOWN_F) - EQUIVALENCE(H5generic_flags(6), H5_ITER_INC_F) - EQUIVALENCE(H5generic_flags(7), H5_ITER_DEC_F) - EQUIVALENCE(H5generic_flags(8), H5_ITER_NATIVE_F) - EQUIVALENCE(H5generic_flags(9), H5_ITER_N_F) - - INTEGER, PARAMETER :: H5generic_haddr_FLAGS_LEN = 1 - INTEGER(HADDR_T) :: H5generic_haddr_flags(H5generic_haddr_FLAGS_LEN) - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5generic_haddr_FLAGS/ - !DEC$endif - COMMON /H5generic_haddr_FLAGS/ H5generic_haddr_flags - - INTEGER(HADDR_T) :: HADDR_UNDEF_F - - EQUIVALENCE(H5generic_haddr_flags(1), HADDR_UNDEF_F) - + INTEGER :: H5F_LIBVER_ERROR_F + INTEGER :: H5F_LIBVER_NBOUNDS_F + INTEGER :: H5F_LIBVER_V18_F + INTEGER :: H5F_LIBVER_V110_F + INTEGER :: H5F_LIBVER_V112_F + INTEGER :: H5F_LIBVER_V114_F ! ! H5G flags declaration ! - INTEGER, PARAMETER :: H5G_FLAGS_LEN = 12 - INTEGER :: H5G_flags(H5G_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5G_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5G_UNKNOWN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_GROUP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_TYPE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_LINK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_UDLINK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_SAME_LOC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_LINK_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_LINK_HARD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_LINK_SOFT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_STORAGE_TYPE_UNKNOWN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_STORAGE_TYPE_SYMBOL_TABLE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_STORAGE_TYPE_COMPACT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5G_STORAGE_TYPE_DENSE_F !DEC$endif - COMMON /H5G_FLAGS/ H5G_flags INTEGER :: H5G_UNKNOWN_F INTEGER :: H5G_GROUP_F @@ -356,34 +304,42 @@ MODULE H5GLOBAL INTEGER :: H5G_STORAGE_TYPE_SYMBOL_TABLE_F INTEGER :: H5G_STORAGE_TYPE_COMPACT_F INTEGER :: H5G_STORAGE_TYPE_DENSE_F - - EQUIVALENCE(H5G_flags(1), H5G_UNKNOWN_F) ! Unknown object type - EQUIVALENCE(H5G_flags(2), H5G_GROUP_F) ! Object is a group - EQUIVALENCE(H5G_flags(3), H5G_DATASET_F) ! Object is a dataset - EQUIVALENCE(H5G_flags(4), H5G_TYPE_F) ! Object is a named data type - EQUIVALENCE(H5G_flags(5), H5G_SAME_LOC_F) - EQUIVALENCE(H5G_flags(6), H5G_LINK_ERROR_F) - EQUIVALENCE(H5G_flags(7), H5G_LINK_HARD_F) - EQUIVALENCE(H5G_flags(8), H5G_LINK_SOFT_F) - - EQUIVALENCE(H5G_flags(9), H5G_STORAGE_TYPE_UNKNOWN_F ) - EQUIVALENCE(H5G_flags(10), H5G_STORAGE_TYPE_SYMBOL_TABLE_F) - EQUIVALENCE(H5G_flags(11), H5G_STORAGE_TYPE_COMPACT_F) - EQUIVALENCE(H5G_flags(12), H5G_STORAGE_TYPE_DENSE_F) - ! ! H5D flags declaration ! - INTEGER, PARAMETER :: H5D_FLAGS_LEN = 29 - INTEGER :: H5D_flags(H5D_FLAGS_LEN) - INTEGER, PARAMETER :: H5D_SIZE_FLAGS_LEN = 2 - INTEGER(SIZE_T) :: H5D_size_flags(H5D_SIZE_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5D_FLAGS/ - !DEC$ATTRIBUTES DLLEXPORT :: /H5D_SIZE_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5D_COMPACT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_CONTIGUOUS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_CHUNKED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_ALLOC_TIME_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_ALLOC_TIME_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_ALLOC_TIME_EARLY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_ALLOC_TIME_LATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_ALLOC_TIME_INCR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SPACE_STS_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SPACE_STS_NOT_ALLOCATED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SPACE_STS_PART_ALLOCATED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_SPACE_STS_ALLOCATED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_TIME_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_TIME_ALLOC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_TIME_NEVER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_VALUE_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_VALUE_UNDEFINED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_VALUE_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_FILL_VALUE_USER_DEFINED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_CHUNK_CACHE_NSLOTS_DFLT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_CHUNK_CACHE_NBYTES_DFLT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_CHUNK_CACHE_W0_DFLT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_NO_COLLECTIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_CHUNK_INDEPENDENT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_CHUNK_COLLECTIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_CHUNK_MIXED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_MPIO_CONTIG_COLLECTIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_VDS_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_VDS_FIRST_MISSING_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_VDS_LAST_AVAILABLE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5D_VIRTUAL_F !DEC$endif - COMMON /H5D_FLAGS/ H5D_flags - COMMON /H5D_SIZE_FLAGS/ H5D_size_flags INTEGER :: H5D_COMPACT_F INTEGER :: H5D_CONTIGUOUS_F @@ -409,13 +365,14 @@ MODULE H5GLOBAL INTEGER :: H5D_FILL_VALUE_DEFAULT_F INTEGER :: H5D_FILL_VALUE_USER_DEFINED_F -! shortened "_DEFAULT" to "_DFLT" to satisfy the limit of 31 -! characters for variable names in Fortran. -! shortened "_CONTIGUOUS" to "_CONTIG" to satisfy the limit of 31 -! characters for variable names in Fortran. + ! shortened "_DEFAULT" to "_DFLT" to satisfy the limit of 31 + ! characters for variable names in Fortran. + ! shortened "_CONTIGUOUS" to "_CONTIG" to satisfy the limit of 31 + ! characters for variable names in Fortran. INTEGER(SIZE_T) :: H5D_CHUNK_CACHE_NSLOTS_DFLT_F INTEGER(SIZE_T) :: H5D_CHUNK_CACHE_NBYTES_DFLT_F + INTEGER :: H5D_CHUNK_CACHE_W0_DFLT_F INTEGER :: H5D_MPIO_NO_COLLECTIVE_F INTEGER :: H5D_MPIO_CHUNK_INDEPENDENT_F @@ -426,80 +383,45 @@ MODULE H5GLOBAL INTEGER :: H5D_VDS_FIRST_MISSING_F INTEGER :: H5D_VDS_LAST_AVAILABLE_F INTEGER :: H5D_VIRTUAL_F - - EQUIVALENCE(H5D_flags(1), H5D_COMPACT_F) - EQUIVALENCE(H5D_flags(2), H5D_CONTIGUOUS_F) - EQUIVALENCE(H5D_flags(3), H5D_CHUNKED_F) - - EQUIVALENCE(H5D_flags(4), H5D_ALLOC_TIME_ERROR_F) - EQUIVALENCE(H5D_flags(5), H5D_ALLOC_TIME_DEFAULT_F) - EQUIVALENCE(H5D_flags(6), H5D_ALLOC_TIME_EARLY_F) - EQUIVALENCE(H5D_flags(7), H5D_ALLOC_TIME_LATE_F) - EQUIVALENCE(H5D_flags(8), H5D_ALLOC_TIME_INCR_F) - - EQUIVALENCE(H5D_flags(9), H5D_SPACE_STS_ERROR_F) - EQUIVALENCE(H5D_flags(10), H5D_SPACE_STS_NOT_ALLOCATED_F) - EQUIVALENCE(H5D_flags(11), H5D_SPACE_STS_PART_ALLOCATED_F) - EQUIVALENCE(H5D_flags(12), H5D_SPACE_STS_ALLOCATED_F) - - EQUIVALENCE(H5D_flags(13), H5D_FILL_TIME_ERROR_F) - EQUIVALENCE(H5D_flags(14), H5D_FILL_TIME_ALLOC_F) - EQUIVALENCE(H5D_flags(15), H5D_FILL_TIME_NEVER_F) - - EQUIVALENCE(H5D_flags(16), H5D_FILL_VALUE_ERROR_F) - EQUIVALENCE(H5D_flags(17), H5D_FILL_VALUE_UNDEFINED_F) - EQUIVALENCE(H5D_flags(18), H5D_FILL_VALUE_DEFAULT_F) - EQUIVALENCE(H5D_flags(19), H5D_FILL_VALUE_USER_DEFINED_F) - - EQUIVALENCE(H5D_flags(20), H5D_CHUNK_CACHE_W0_DFLT_F) - EQUIVALENCE(H5D_flags(21), H5D_MPIO_NO_COLLECTIVE_F) - EQUIVALENCE(H5D_flags(22), H5D_MPIO_CHUNK_INDEPENDENT_F) - EQUIVALENCE(H5D_flags(23), H5D_MPIO_CHUNK_COLLECTIVE_F) - EQUIVALENCE(H5D_flags(24), H5D_MPIO_CHUNK_MIXED_F) - EQUIVALENCE(H5D_flags(25), H5D_MPIO_CONTIG_COLLECTIVE_F) - EQUIVALENCE(H5D_flags(26), H5D_VDS_ERROR_F) - EQUIVALENCE(H5D_flags(27), H5D_VDS_FIRST_MISSING_F) - EQUIVALENCE(H5D_flags(28), H5D_VDS_LAST_AVAILABLE_F) - EQUIVALENCE(H5D_flags(29), H5D_VIRTUAL_F) - - EQUIVALENCE(H5D_size_flags(1), H5D_CHUNK_CACHE_NSLOTS_DFLT_F) - EQUIVALENCE(H5D_size_flags(2), H5D_CHUNK_CACHE_NBYTES_DFLT_F) - ! ! H5E flags declaration ! - INTEGER, PARAMETER :: H5E_FLAGS_LEN = 4 - INTEGER :: H5E_flags(H5E_FLAGS_LEN) - INTEGER, PARAMETER :: H5E_HID_FLAGS_LEN = 1 - INTEGER(HID_T) :: H5E_hid_flags(H5E_HID_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5E_FLAGS/ - !DEC$ATTRIBUTES DLLEXPORT :: /H5E_HID_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5E_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5E_MAJOR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5E_MINOR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5E_WALK_UPWARD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5E_WALK_DOWNWARD_F !DEC$endif - COMMON /H5E_FLAGS/ H5E_flags - COMMON /H5E_HID_FLAGS/ H5E_hid_flags INTEGER(HID_T) :: H5E_DEFAULT_F INTEGER :: H5E_MAJOR_F INTEGER :: H5E_MINOR_F INTEGER :: H5E_WALK_UPWARD_F INTEGER :: H5E_WALK_DOWNWARD_F - - EQUIVALENCE(H5E_hid_flags(1), H5E_DEFAULT_F) - EQUIVALENCE(H5E_flags(1) , H5E_MAJOR_F) - EQUIVALENCE(H5E_flags(2) , H5E_MINOR_F) - EQUIVALENCE(H5E_flags(3) , H5E_WALK_UPWARD_F) - EQUIVALENCE(H5E_flags(4) , H5E_WALK_DOWNWARD_F) - ! - ! H5FD flags declaration + ! H5FD file drivers flags declaration ! - INTEGER, PARAMETER :: H5FD_FLAGS_LEN = 11 - INTEGER :: H5FD_flags(H5FD_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5FD_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MPIO_INDEPENDENT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MPIO_COLLECTIVE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_NOLIST_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_SUPER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_BTREE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_DRAW_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_GHEAP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_LHEAP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_OHDR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MEM_NTYPES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_CORE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_FAMILY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_LOG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MPIO_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_MULTI_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_SEC2_F + !DEC$ATTRIBUTES DLLEXPORT :: H5FD_STDIO_F !DEC$endif - COMMON /H5FD_FLAGS/ H5FD_flags INTEGER :: H5FD_MPIO_INDEPENDENT_F INTEGER :: H5FD_MPIO_COLLECTIVE_F @@ -512,28 +434,6 @@ MODULE H5GLOBAL INTEGER :: H5FD_MEM_LHEAP_F INTEGER :: H5FD_MEM_OHDR_F INTEGER :: H5FD_MEM_NTYPES_F - - EQUIVALENCE(H5FD_flags(1), H5FD_MPIO_INDEPENDENT_F) - EQUIVALENCE(H5FD_flags(2), H5FD_MPIO_COLLECTIVE_F) - EQUIVALENCE(H5FD_flags(3), H5FD_MEM_NOLIST_F) - EQUIVALENCE(H5FD_flags(4), H5FD_MEM_DEFAULT_F) - EQUIVALENCE(H5FD_flags(5), H5FD_MEM_SUPER_F) - EQUIVALENCE(H5FD_flags(6), H5FD_MEM_BTREE_F) - EQUIVALENCE(H5FD_flags(7), H5FD_MEM_DRAW_F) - EQUIVALENCE(H5FD_flags(8), H5FD_MEM_GHEAP_F) - EQUIVALENCE(H5FD_flags(9), H5FD_MEM_LHEAP_F) - EQUIVALENCE(H5FD_flags(10), H5FD_MEM_OHDR_F) - EQUIVALENCE(H5FD_flags(11), H5FD_MEM_NTYPES_F) - ! - ! H5FD file drivers flags declaration - ! - INTEGER, PARAMETER :: H5FD_HID_FLAGS_LEN = 7 - INTEGER(HID_T) :: H5FD_hid_flags(H5FD_HID_FLAGS_LEN) - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5FD_HID_FLAGS/ - !DEC$endif - COMMON /H5FD_HID_FLAGS/ H5FD_hid_flags - INTEGER(HID_T) :: H5FD_CORE_F INTEGER(HID_T) :: H5FD_FAMILY_F INTEGER(HID_T) :: H5FD_LOG_F @@ -541,45 +441,58 @@ MODULE H5GLOBAL INTEGER(HID_T) :: H5FD_MULTI_F INTEGER(HID_T) :: H5FD_SEC2_F INTEGER(HID_T) :: H5FD_STDIO_F - - EQUIVALENCE(H5FD_hid_flags(1), H5FD_CORE_F) - EQUIVALENCE(H5FD_hid_flags(2), H5FD_FAMILY_F) - EQUIVALENCE(H5FD_hid_flags(3), H5FD_LOG_F) - EQUIVALENCE(H5FD_hid_flags(4), H5FD_MPIO_F) - EQUIVALENCE(H5FD_hid_flags(5), H5FD_MULTI_F) - EQUIVALENCE(H5FD_hid_flags(6), H5FD_SEC2_F) - EQUIVALENCE(H5FD_hid_flags(7), H5FD_STDIO_F) - ! ! H5I flags declaration ! - INTEGER, PARAMETER :: H5I_FLAGS_LEN = 7 - INTEGER :: H5I_flags(H5I_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5I_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5I_FILE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_GROUP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_DATATYPE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_DATASPACE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_ATTR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_BADID_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_UNINIT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_VFL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_VOL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_GENPROP_CLS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_GENPROP_LST_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_ERROR_CLASS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_ERROR_MSG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_ERROR_STACK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_NTYPES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5I_INVALID_HID_F !DEC$endif - COMMON /H5I_FLAGS/ H5I_flags - INTEGER :: H5I_FILE_F - INTEGER :: H5I_GROUP_F - INTEGER :: H5I_DATATYPE_F - INTEGER :: H5I_DATASPACE_F - INTEGER :: H5I_DATASET_F - INTEGER :: H5I_ATTR_F - INTEGER :: H5I_BADID_F + INTEGER :: H5I_FILE_F + INTEGER :: H5I_GROUP_F + INTEGER :: H5I_DATATYPE_F + INTEGER :: H5I_DATASPACE_F + INTEGER :: H5I_DATASET_F + INTEGER :: H5I_ATTR_F + INTEGER :: H5I_BADID_F + INTEGER :: H5I_UNINIT_F + INTEGER :: H5I_VFL_F + INTEGER :: H5I_VOL_F + INTEGER :: H5I_GENPROP_CLS_F + INTEGER :: H5I_GENPROP_LST_F + INTEGER :: H5I_ERROR_CLASS_F + INTEGER :: H5I_ERROR_MSG_F + INTEGER :: H5I_ERROR_STACK_F + INTEGER :: H5I_NTYPES_F + INTEGER :: H5I_INVALID_HID_F - EQUIVALENCE(H5I_flags(1), H5I_FILE_F) - EQUIVALENCE(H5I_flags(2), H5I_GROUP_F) - EQUIVALENCE(H5I_flags(3), H5I_DATATYPE_F) - EQUIVALENCE(H5I_flags(4), H5I_DATASPACE_F) - EQUIVALENCE(H5I_flags(5), H5I_DATASET_F) - EQUIVALENCE(H5I_flags(6), H5I_ATTR_F) - EQUIVALENCE(H5I_flags(7), H5I_BADID_F) ! ! H5L flags declaration ! - INTEGER, PARAMETER :: H5L_FLAGS_LEN = 6 - INTEGER :: H5L_flags(H5L_FLAGS_LEN) + !DEC$if defined(BUILD_HDF5_DLL) + !DEC$ATTRIBUTES DLLEXPORT :: H5L_TYPE_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5L_TYPE_HARD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5L_TYPE_SOFT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5L_TYPE_EXTERNAL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5L_SAME_LOC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5L_LINK_CLASS_T_VERS_F + !DEC$endif INTEGER :: H5L_TYPE_ERROR_F INTEGER :: H5L_TYPE_HARD_F @@ -587,27 +500,45 @@ MODULE H5GLOBAL INTEGER :: H5L_TYPE_EXTERNAL_F INTEGER :: H5L_SAME_LOC_F INTEGER :: H5L_LINK_CLASS_T_VERS_F - - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5L_FLAGS/ - !DEC$endif - COMMON /H5L_FLAGS/ H5L_flags - - EQUIVALENCE(H5L_flags(1), H5L_TYPE_ERROR_F) - EQUIVALENCE(H5L_flags(2), H5L_TYPE_HARD_F) - EQUIVALENCE(H5L_flags(3), H5L_TYPE_SOFT_F) - EQUIVALENCE(H5L_flags(4), H5L_TYPE_EXTERNAL_F) - EQUIVALENCE(H5L_flags(5), H5L_SAME_LOC_F) - EQUIVALENCE(H5L_flags(6), H5L_LINK_CLASS_T_VERS_F) ! ! H5O flags declaration ! - INTEGER, PARAMETER :: H5O_FLAGS_LEN = 27 - INTEGER :: H5o_flags(H5O_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5O_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_SHALLOW_HIERARCHY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_EXPAND_SOFT_LINK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_EXPAND_EXT_LINK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_EXPAND_REFERENCE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_WITHOUT_ATTR_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_PRESERVE_NULL_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_COPY_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_NONE_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_SDSPACE_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_DTYPE_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_FILL_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_PLINE_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_ATTR_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_ALL_FLAG_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_CHUNK0_SIZE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_ATTR_CRT_ORDER_TRACK_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_ATTR_CRT_ORDER_INDEX_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_ATTR_STORE_PHASE_CHA_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_STORE_TIMES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_HDR_ALL_FLAGS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_MAX_NINDEXES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_SHMESG_MAX_LIST_SIZE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_UNKNOWN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_GROUP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_DATASET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NAMED_DATATYPE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NTYPES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_BASIC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_TIME_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_NUM_ATTRS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_HDR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_META_SIZE_F + ! !DEC$endif - COMMON /H5O_FLAGS/ H5O_flags INTEGER :: H5O_COPY_SHALLOW_HIERARCHY_F ! *** THESE VARIABLES DO INTEGER :: H5O_COPY_EXPAND_SOFT_LINK_F ! NOT MATCH THE C VARIABLE @@ -636,44 +567,37 @@ MODULE H5GLOBAL INTEGER :: H5O_TYPE_DATASET_F INTEGER :: H5O_TYPE_NAMED_DATATYPE_F INTEGER :: H5O_TYPE_NTYPES_F - - EQUIVALENCE(h5o_flags(1) , H5O_COPY_SHALLOW_HIERARCHY_F) - EQUIVALENCE(h5o_flags(2) , H5O_COPY_EXPAND_SOFT_LINK_F) - EQUIVALENCE(h5o_flags(3) , H5O_COPY_EXPAND_EXT_LINK_F) - EQUIVALENCE(h5o_flags(4) , H5O_COPY_EXPAND_REFERENCE_F) - EQUIVALENCE(h5o_flags(5) , H5O_COPY_WITHOUT_ATTR_FLAG_F) - EQUIVALENCE(h5o_flags(6) , H5O_COPY_PRESERVE_NULL_FLAG_F) - EQUIVALENCE(h5o_flags(7) , H5O_COPY_ALL_F) - EQUIVALENCE(h5o_flags(8) , H5O_SHMESG_NONE_FLAG_F) - EQUIVALENCE(h5o_flags(9) , H5O_SHMESG_SDSPACE_FLAG_F) - EQUIVALENCE(h5o_flags(10) , H5O_SHMESG_DTYPE_FLAG_F) - EQUIVALENCE(h5o_flags(11) , H5O_SHMESG_FILL_FLAG_F) - EQUIVALENCE(h5o_flags(12) , H5O_SHMESG_PLINE_FLAG_F) - EQUIVALENCE(h5o_flags(13) , H5O_SHMESG_ATTR_FLAG_F) - EQUIVALENCE(h5o_flags(14) , H5O_SHMESG_ALL_FLAG_F) - EQUIVALENCE(h5o_flags(15) , H5O_HDR_CHUNK0_SIZE_F) - EQUIVALENCE(h5o_flags(16) , H5O_HDR_ATTR_CRT_ORDER_TRACK_F) - EQUIVALENCE(h5o_flags(17) , H5O_HDR_ATTR_CRT_ORDER_INDEX_F) - EQUIVALENCE(h5o_flags(18) , H5O_HDR_ATTR_STORE_PHASE_CHA_F) - EQUIVALENCE(h5o_flags(19) , H5O_HDR_STORE_TIMES_F) - EQUIVALENCE(h5o_flags(20) , H5O_HDR_ALL_FLAGS_F) - EQUIVALENCE(h5o_flags(21) , H5O_SHMESG_MAX_NINDEXES_F) - EQUIVALENCE(h5o_flags(22) , H5O_SHMESG_MAX_LIST_SIZE_F) - EQUIVALENCE(h5o_flags(23) , H5O_TYPE_UNKNOWN_F) - EQUIVALENCE(h5o_flags(24) , H5O_TYPE_GROUP_F) - EQUIVALENCE(h5o_flags(25) , H5O_TYPE_DATASET_F) - EQUIVALENCE(h5o_flags(26) , H5O_TYPE_NAMED_DATATYPE_F) - EQUIVALENCE(h5o_flags(27) , H5O_TYPE_NTYPES_F) - + INTEGER :: H5O_INFO_ALL_F + INTEGER :: H5O_INFO_BASIC_F + INTEGER :: H5O_INFO_TIME_F + INTEGER :: H5O_INFO_NUM_ATTRS_F + INTEGER :: H5O_INFO_HDR_F + INTEGER :: H5O_INFO_META_SIZE_F ! ! H5P flags declaration ! - INTEGER, PARAMETER :: H5P_FLAGS_LEN = 18 - INTEGER(HID_T) H5P_flags(H5P_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5P_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5P_FILE_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_FILE_ACCESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DATASET_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DATASET_XFER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_FILE_MOUNT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DEFAULT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_ROOT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_OBJECT_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DATASET_ACCESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_GROUP_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_GROUP_ACCESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DATATYPE_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_DATATYPE_ACCESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_STRING_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_ATTRIBUTE_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_OBJECT_COPY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_LINK_CREATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_LINK_ACCESS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_CRT_ORDER_INDEXED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5P_CRT_ORDER_TRACKED_F !DEC$endif - COMMON /H5P_FLAGS/ H5P_flags INTEGER(HID_T) :: H5P_FILE_CREATE_F INTEGER(HID_T) :: H5P_FILE_ACCESS_F @@ -694,71 +618,43 @@ MODULE H5GLOBAL INTEGER(HID_T) :: H5P_LINK_CREATE_F INTEGER(HID_T) :: H5P_LINK_ACCESS_F - EQUIVALENCE(H5P_flags(1), H5P_FILE_CREATE_F) - EQUIVALENCE(H5P_flags(2), H5P_FILE_ACCESS_F) - EQUIVALENCE(H5P_flags(3), H5P_DATASET_CREATE_F) - EQUIVALENCE(H5P_flags(4), H5P_DATASET_XFER_F) - EQUIVALENCE(H5P_flags(5), H5P_FILE_MOUNT_F) - EQUIVALENCE(H5P_flags(6), H5P_DEFAULT_F) - EQUIVALENCE(H5P_flags(7), H5P_ROOT_F) - EQUIVALENCE(H5P_flags(8), H5P_OBJECT_CREATE_F) - EQUIVALENCE(H5P_flags(9), H5P_DATASET_ACCESS_F) - EQUIVALENCE(H5P_flags(10), H5P_GROUP_CREATE_F) - EQUIVALENCE(H5P_flags(11), H5P_GROUP_ACCESS_F) - EQUIVALENCE(H5P_flags(12), H5P_DATATYPE_CREATE_F) - EQUIVALENCE(H5P_flags(13), H5P_DATATYPE_ACCESS_F) - EQUIVALENCE(H5P_flags(14), H5P_STRING_CREATE_F) - EQUIVALENCE(H5P_flags(15), H5P_ATTRIBUTE_CREATE_F) - EQUIVALENCE(H5P_flags(16), H5P_OBJECT_COPY_F) - EQUIVALENCE(H5P_flags(17), H5P_LINK_CREATE_F) - EQUIVALENCE(H5P_flags(18), H5P_LINK_ACCESS_F) - - ! - ! H5P integers flags declaration - ! - INTEGER, PARAMETER :: H5P_FLAGS_INT_LEN = 2 - INTEGER :: H5P_flags_int(H5P_FLAGS_INT_LEN) - !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5P_FLAGS_INT/ - !DEC$endif - COMMON /H5P_FLAGS_INT/ H5P_flags_int INTEGER :: H5P_CRT_ORDER_INDEXED_F INTEGER :: H5P_CRT_ORDER_TRACKED_F - EQUIVALENCE(H5P_flags_int(1), H5P_CRT_ORDER_INDEXED_F) - EQUIVALENCE(H5P_flags_int(2), H5P_CRT_ORDER_TRACKED_F) ! ! H5R flags declaration ! - INTEGER, PARAMETER :: H5R_FLAGS_LEN = 2 - INTEGER :: H5R_flags(H5R_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5R_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5R_OBJECT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5R_DATASET_REGION_F !DEC$endif - COMMON /H5R_FLAGS/ H5R_flags INTEGER :: H5R_OBJECT_F INTEGER :: H5R_DATASET_REGION_F - - EQUIVALENCE(H5R_flags(1), H5R_OBJECT_F) - EQUIVALENCE(H5R_flags(2), H5R_DATASET_REGION_F) - ! ! H5S flags declaration ! - INTEGER, PARAMETER :: H5S_FLAGS_LEN = 18 - INTEGER :: H5S_flags(H5S_FLAGS_LEN) - INTEGER, PARAMETER :: H5S_HSIZE_FLAGS_LEN = 1 - INTEGER(HSIZE_T) H5S_hsize_flags(H5S_HSIZE_FLAGS_LEN) - INTEGER, PARAMETER :: H5S_HID_FLAGS_LEN = 1 - INTEGER(HSIZE_T) H5S_hid_flags(H5S_HID_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5S_FLAGS/ - !DEC$ATTRIBUTES DLLEXPORT :: /H5S_HID_FLAGS/ - !DEC$ATTRIBUTES DLLEXPORT :: /H5S_HSIZE_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5S_UNLIMITED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SCALAR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SIMPLE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_NULL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_NOOP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_SET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_OR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_AND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_XOR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_NOTB_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_NOTA_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_APPEND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_PREPEND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SELECT_INVALID_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SEL_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SEL_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SEL_POINTS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SEL_HYPERSLABS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5S_SEL_ALL_F !DEC$endif - COMMON /H5S_FLAGS/ H5S_flags - COMMON /H5S_HID_FLAGS/ H5S_hid_flags - COMMON /H5S_HSIZE_FLAGS/ H5S_hsize_flags INTEGER(HSIZE_T) :: H5S_UNLIMITED_F @@ -784,42 +680,46 @@ MODULE H5GLOBAL INTEGER :: H5S_SEL_POINTS_F INTEGER :: H5S_SEL_HYPERSLABS_F INTEGER :: H5S_SEL_ALL_F - - EQUIVALENCE(H5S_hid_flags(1), H5S_ALL_F) - - EQUIVALENCE(H5S_hsize_flags(1), H5S_UNLIMITED_F) - - EQUIVALENCE(H5S_flags(1), H5S_SCALAR_F) - EQUIVALENCE(H5S_flags(2), H5S_SIMPLE_F) - EQUIVALENCE(H5S_flags(3), H5S_NULL_F) - EQUIVALENCE(H5S_flags(4), H5S_SELECT_SET_F) - EQUIVALENCE(H5S_flags(5), H5S_SELECT_OR_F) - - EQUIVALENCE(H5S_flags(6), H5S_SELECT_NOOP_F) - EQUIVALENCE(H5S_flags(7), H5S_SELECT_AND_F) - EQUIVALENCE(H5S_flags(8), H5S_SELECT_XOR_F) - EQUIVALENCE(H5S_flags(9), H5S_SELECT_NOTB_F) - EQUIVALENCE(H5S_flags(10), H5S_SELECT_NOTA_F) - - EQUIVALENCE(H5S_flags(11), H5S_SELECT_APPEND_F) - EQUIVALENCE(H5S_flags(12), H5S_SELECT_PREPEND_F) - EQUIVALENCE(H5S_flags(13), H5S_SELECT_INVALID_F) - EQUIVALENCE(H5S_flags(14), H5S_SEL_ERROR_F) - EQUIVALENCE(H5S_flags(15), H5S_SEL_NONE_F) - - EQUIVALENCE(H5S_flags(16), H5S_SEL_POINTS_F) - EQUIVALENCE(H5S_flags(17), H5S_SEL_HYPERSLABS_F) - EQUIVALENCE(H5S_flags(18), H5S_SEL_ALL_F) - ! ! H5T flags declaration ! - INTEGER, PARAMETER :: H5T_FLAGS_LEN = 35 - INTEGER :: H5T_flags(H5T_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5T_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NO_CLASS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_INTEGER_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_FLOAT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_TIME_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STRING_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_BITFIELD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_OPAQUE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_COMPOUND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_REFERENCE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ENUM_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_VLEN_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ARRAY_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ORDER_LE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ORDER_BE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ORDER_VAX_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ORDER_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_ORDER_MIXED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_PAD_ZERO_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_PAD_ONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_PAD_BACKGROUND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_PAD_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_SGN_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_SGN_2_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_SGN_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NORM_IMPLIED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NORM_MSBSET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_NORM_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_CSET_ASCII_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_CSET_UTF8_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STR_NULLTERM_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STR_NULLPAD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STR_SPACEPAD_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_STR_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_DIR_ASCEND_F + !DEC$ATTRIBUTES DLLEXPORT :: H5T_DIR_DESCEND_F !DEC$endif - COMMON /H5T_FLAGS/ H5T_flags INTEGER :: H5T_NO_CLASS_F INTEGER :: H5T_INTEGER_F @@ -856,51 +756,31 @@ MODULE H5GLOBAL INTEGER :: H5T_STR_ERROR_F INTEGER :: H5T_DIR_ASCEND_F INTEGER :: H5T_DIR_DESCEND_F - - EQUIVALENCE(H5T_flags(1), H5T_NO_CLASS_F) - EQUIVALENCE(H5T_flags(2), H5T_INTEGER_F) - EQUIVALENCE(H5T_flags(3), H5T_FLOAT_F) - EQUIVALENCE(H5T_flags(4), H5T_TIME_F) - EQUIVALENCE(H5T_flags(5), H5T_STRING_F) - EQUIVALENCE(H5T_flags(6), H5T_BITFIELD_F) - EQUIVALENCE(H5T_flags(7), H5T_OPAQUE_F) - EQUIVALENCE(H5T_flags(8), H5T_COMPOUND_F) - EQUIVALENCE(H5T_flags(9), H5T_REFERENCE_F) - EQUIVALENCE(H5T_flags(10), H5T_ENUM_F) - EQUIVALENCE(H5T_flags(11), H5T_ORDER_LE_F) - EQUIVALENCE(H5T_flags(12), H5T_ORDER_BE_F) - EQUIVALENCE(H5T_flags(13), H5T_ORDER_MIXED_F) - EQUIVALENCE(H5T_flags(14), H5T_ORDER_VAX_F) - EQUIVALENCE(H5T_flags(15), H5T_ORDER_NONE_F) - EQUIVALENCE(H5T_flags(16), H5T_PAD_ZERO_F) - EQUIVALENCE(H5T_flags(17), H5T_PAD_ONE_F) - EQUIVALENCE(H5T_flags(18), H5T_PAD_BACKGROUND_F) - EQUIVALENCE(H5T_flags(19), H5T_PAD_ERROR_F) - EQUIVALENCE(H5T_flags(20), H5T_SGN_NONE_F) - EQUIVALENCE(H5T_flags(21), H5T_SGN_2_F) - EQUIVALENCE(H5T_flags(22), H5T_SGN_ERROR_F) - EQUIVALENCE(H5T_flags(23), H5T_NORM_IMPLIED_F) - EQUIVALENCE(H5T_flags(24), H5T_NORM_MSBSET_F) - EQUIVALENCE(H5T_flags(25), H5T_NORM_NONE_F) - EQUIVALENCE(H5T_flags(26), H5T_CSET_ASCII_F) - EQUIVALENCE(H5T_flags(27), H5T_CSET_UTF8_F) - EQUIVALENCE(H5T_flags(28), H5T_STR_NULLTERM_F) - EQUIVALENCE(H5T_flags(29), H5T_STR_NULLPAD_F) - EQUIVALENCE(H5T_flags(30), H5T_STR_SPACEPAD_F) - EQUIVALENCE(H5T_flags(31), H5T_STR_ERROR_F) - EQUIVALENCE(H5T_flags(32), H5T_VLEN_F) - EQUIVALENCE(H5T_flags(33), H5T_ARRAY_F) - EQUIVALENCE(H5T_flags(34), H5T_DIR_ASCEND_F) - EQUIVALENCE(H5T_flags(35), H5T_DIR_DESCEND_F) ! ! H5Z flags declaration ! - INTEGER, PARAMETER :: H5Z_FLAGS_LEN = 20 - INTEGER :: H5Z_flags(H5Z_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5Z_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_ERROR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_NONE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_DEFLATE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_SHUFFLE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_FLETCHER32_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_SZIP_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_ERROR_EDC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_DISABLE_EDC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_ENABLE_EDC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_NO_EDC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FLAG_OPTIONAL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_ENCODE_ENABLED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_DECODE_ENABLED_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_NBIT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_FILTER_SCALEOFFSET_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_SO_FLOAT_DSCALE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_SO_FLOAT_ESCALE_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_SO_INT_F + !DEC$ATTRIBUTES DLLEXPORT :: H5Z_SO_INT_MINBITS_DEFAULT_F !DEC$endif - COMMON /H5Z_FLAGS/ H5Z_flags INTEGER :: H5Z_FILTER_ERROR_F INTEGER :: H5Z_FILTER_NONE_F @@ -922,58 +802,16 @@ MODULE H5GLOBAL INTEGER :: H5Z_SO_FLOAT_ESCALE_F INTEGER :: H5Z_SO_INT_F INTEGER :: H5Z_SO_INT_MINBITS_DEFAULT_F - - EQUIVALENCE(H5Z_flags(1), H5Z_FILTER_ERROR_F) - EQUIVALENCE(H5Z_flags(2), H5Z_FILTER_NONE_F) - EQUIVALENCE(H5Z_flags(3), H5Z_FILTER_DEFLATE_F) - EQUIVALENCE(H5Z_flags(4), H5Z_FILTER_SHUFFLE_F) - EQUIVALENCE(H5Z_flags(5), H5Z_FILTER_FLETCHER32_F) - EQUIVALENCE(H5Z_flags(6), H5Z_ERROR_EDC_F) - EQUIVALENCE(H5Z_flags(7), H5Z_DISABLE_EDC_F) - EQUIVALENCE(H5Z_flags(8), H5Z_ENABLE_EDC_F) - EQUIVALENCE(H5Z_flags(9), H5Z_NO_EDC_F) - EQUIVALENCE(H5Z_flags(10), H5Z_FILTER_SZIP_F) - EQUIVALENCE(H5Z_flags(11), H5Z_FLAG_OPTIONAL_F) - EQUIVALENCE(H5Z_flags(12), H5Z_FILTER_ENCODE_ENABLED_F) - EQUIVALENCE(H5Z_flags(13), H5Z_FILTER_DECODE_ENABLED_F) - EQUIVALENCE(H5Z_flags(14), H5Z_FILTER_ALL_F) - EQUIVALENCE(H5Z_flags(15), H5Z_FILTER_NBIT_F) - EQUIVALENCE(H5Z_flags(16), H5Z_FILTER_SCALEOFFSET_F) - EQUIVALENCE(H5Z_flags(17), H5Z_SO_FLOAT_DSCALE_F) - EQUIVALENCE(H5Z_flags(18), H5Z_SO_FLOAT_ESCALE_F) - EQUIVALENCE(H5Z_flags(19), H5Z_SO_INT_F) - EQUIVALENCE(H5Z_flags(20), H5Z_SO_INT_MINBITS_DEFAULT_F) - ! ! H5 Library flags declaration ! - INTEGER, PARAMETER :: H5LIB_FLAGS_LEN = 2 - INTEGER :: H5LIB_flags(H5LIB_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) - !DEC$ATTRIBUTES DLLEXPORT :: /H5LIB_FLAGS/ + !DEC$ATTRIBUTES DLLEXPORT :: H5_SZIP_EC_OM_F + !DEC$ATTRIBUTES DLLEXPORT :: H5_SZIP_NN_OM_F !DEC$endif - COMMON /H5LIB_FLAGS/ H5LIB_flags + INTEGER :: H5_SZIP_EC_OM_F INTEGER :: H5_SZIP_NN_OM_F - ! - EQUIVALENCE(H5LIB_flags(1), H5_SZIP_EC_OM_F) - EQUIVALENCE(H5LIB_flags(2), H5_SZIP_NN_OM_F) - - - ! General H5 flags declarations - ! -!!$ INTEGER, PARAMETER :: H5_FLAGS_LEN = 2 -!!$ INTEGER H5_flags(H5_FLAGS_LEN) -!!$!DEC$if defined(BUILD_HDF5_DLL) -!!$!DEC$ATTRIBUTES DLLEXPORT :: /H5_FLAGS/ -!!$!DEC$endif -!!$ COMMON /H5_FLAGS/ H5_flags -!!$ -!!$ INTEGER :: _F -!!$ INTEGER :: H5F_SCOPE_LOCAL_F -!!$ -!!$ EQUIVALENCE(H5F_flags(1), H5F_SCOPE_GLOBAL_F) -!!$ EQUIVALENCE(H5F_flags(2), H5F_SCOPE_LOCAL_F) CONTAINS @@ -981,7 +819,7 @@ CONTAINS SUBROUTINE H5_Fortran_string_c2f(c_string, f_string) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_CHAR, C_NULL_CHAR IMPLICIT NONE CHARACTER(KIND=C_CHAR, LEN=*), INTENT(IN) :: c_string CHARACTER(LEN=*), INTENT(OUT) :: f_string @@ -993,11 +831,11 @@ CONTAINS f_len = LEN(f_string) ! CASE (1): C string is equal to or larger than Fortran character buffer, - ! so fill the entire Fortran buffer. + ! so fill the entire Fortran buffer. IF(c_len.GE.f_len)THEN ! f_string(1:f_len) = c_string(1:f_len) - ! CASE (2): C string is smaller than Fortran character buffer, + ! CASE (2): C string is smaller than Fortran character buffer, ! so copy C string and blank pad remaining characters. ELSE f_string(1:c_len) = c_string(1:c_len) @@ -1007,7 +845,7 @@ CONTAINS SUBROUTINE H5_Fortran_string_f2c(f_string, c_string) - USE, INTRINSIC :: ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_CHAR, C_NULL_CHAR IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: f_string CHARACTER(KIND=C_CHAR, LEN=*), INTENT(OUT) :: c_string @@ -1064,6 +902,6 @@ CONTAINS !!$ fstring(j:j) = ' ' !!$ end do !!$end subroutine MPIR_Fortran_string_c2f - + END MODULE H5GLOBAL diff --git a/fortran/src/H5f90i.h b/fortran/src/H5f90i.h index 7d066cd..057edc5 100644 --- a/fortran/src/H5f90i.h +++ b/fortran/src/H5f90i.h @@ -21,8 +21,7 @@ */ #include "H5f90i_gen.h" -/* Define _fcd. These are the same on every system - * but UNICOS. +/* Define _fcd. These are the same on every system but UNICOS. */ #define _fcdtocp(desc) (desc) diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 46ef8ef..695efcd 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -23,7 +23,7 @@ H5_FCDLL void HD5packFstring(char *src, char *dest, size_t len); /* - * Storage info struct used by H5O_info_t and H5F_info_t + * Storage info struct used by H5O_info_t and H5F_info_t * interoperable with Fortran. */ typedef struct H5_ih_info_t_f { @@ -31,7 +31,7 @@ typedef struct H5_ih_info_t_f { hsize_t heap_size; } H5_ih_info_t_f; -/* Information struct for object header metadata (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) +/* Information struct for object header metadata (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) * interoperable with Fortran. */ typedef struct H5O_hdr_info_t_f { @@ -51,12 +51,11 @@ typedef struct H5O_hdr_info_t_f { } mesg; } H5O_hdr_info_t_f; -/* Information struct for object (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) - * interoperable with Fortran. +/* Information struct for object (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) */ typedef struct H5O_info_t_f { unsigned long fileno; /* File number that object is located in */ - haddr_t_f addr; /* Object address in file */ + H5O_token_t token; /* Token of object in file */ int type; /* Basic object type (group, dataset, etc.) */ int_f rc; /* Reference count of object */ int_f atime[8]; /* Access time */ @@ -64,13 +63,18 @@ typedef struct H5O_info_t_f { int_f ctime[8]; /* Change time */ int_f btime[8]; /* Birth time */ hsize_t num_attrs; /* # of attributes attached to object */ +} H5O_info_t_f; + +/* Information struct for native object (for H5Oget_native_info/H5Oget_native_info_by_name/H5Oget_native_info_by_idx) + */ +typedef struct H5O_native_info_t_f { H5O_hdr_info_t_f hdr; /* Object header information */ /* Extra metadata storage for obj & attributes */ struct { H5_ih_info_t_f obj; /* v1/v2 B-tree & local/fractal heap for groups, B-tree for chunked datasets */ H5_ih_info_t_f attr; /* v2 B-tree & heap for attributes */ } meta_size; -} H5O_info_t_f; +} H5O_native_info_t_f; /* @@ -78,7 +82,6 @@ typedef struct H5O_info_t_f { */ H5_FCDLL int_f h5fcreate_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *crt_prp, hid_t_f *acc_prp, hid_t_f *file_id); H5_FCDLL int_f h5fopen_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hid_t_f *file_id); -H5_FCDLL int_f h5fis_hdf5_c(_fcd name, int_f *namelen, int_f *flag); H5_FCDLL int_f h5fclose_c(hid_t_f *file_id); H5_FCDLL int_f h5fmount_c(hid_t_f *loc_id, _fcd dsetname, int_f *namelen, hid_t_f *file_id, hid_t_f *acc_prp); H5_FCDLL int_f h5funmount_c(hid_t_f *loc_id, _fcd dsetname, int_f *namelen); @@ -92,6 +95,7 @@ H5_FCDLL int_f h5fget_file_image_c(hid_t_f *file_id, void *buf_ptr, size_t_f *bu H5_FCDLL int_f h5fflush_c(hid_t_f *obj_id, int_f *scope); H5_FCDLL int_f h5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen); H5_FCDLL int_f h5fget_filesize_c(hid_t_f *file_id, hsize_t_f *size); +H5_FCDLL int_f h5fget_fileno_c(hid_t_f *file_id, int_f *fileno); /* * Functions from H5Sf.c @@ -123,9 +127,9 @@ H5_FCDLL int_f h5sget_select_type_c( hid_t_f *space_id , int_f *op); H5_FCDLL int_f h5sselect_elements_c( hid_t_f *space_id , int_f *op, size_t_f *nelements, hsize_t_f *coord); H5_FCDLL int_f h5scombine_hyperslab_c( hid_t_f *space_id , int_f *op, hsize_t_f *start, hsize_t_f *count, hsize_t_f *stride, hsize_t_f *block, hid_t_f *hyper_id); H5_FCDLL int_f h5scombine_select_c( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id, hid_t_f *ds_id); -H5_FCDLL int_f h5sselect_select_c( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id); +H5_FCDLL int_f h5smodify_select_c( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id); H5_FCDLL int_f h5sdecode_c( _fcd buf, hid_t_f *obj_id ); -H5_FCDLL int_f h5sencode_c(_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ); +H5_FCDLL int_f h5sencode_c(_fcd buf, hid_t_f *obj_id, size_t_f *nalloc, hid_t_f *fapl_id ); H5_FCDLL int_f h5sextent_equal_c( hid_t_f * space1_id, hid_t_f *space2_id, hid_t_f *c_equal); /* @@ -156,9 +160,9 @@ H5_FCDLL int_f h5dfill_c(void * fill_value, hid_t_f *fill_type_id, hid_t_f *spac H5_FCDLL int_f h5dget_space_status_c( hid_t_f *dset_id, int_f *flag); H5_FCDLL int_f h5dcreate_anon_c(hid_t_f *loc_id, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id); -H5_FCDLL int_f h5dwrite_f_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, +H5_FCDLL int_f h5dwrite_f_c(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf); -H5_FCDLL int_f h5dread_f_c( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_space_id, +H5_FCDLL int_f h5dread_f_c( hid_t_f *dset_id , hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf); H5_FCDLL int_f h5dvlen_reclaim_c(hid_t_f *type_id , hid_t_f *space_id, hid_t_f *plist_id, void *buf); @@ -312,30 +316,32 @@ H5_FCDLL int_f h5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts, H5_FCDLL int_f h5oopen_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id); H5_FCDLL int_f h5oclose_c(hid_t_f *object_id ); -H5_FCDLL int_f h5oopen_by_addr_c(hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id); +H5_FCDLL int_f h5oopen_by_token_c(hid_t_f *loc_id, H5O_token_t *token, hid_t_f *obj_id); H5_FCDLL int_f h5olink_c(hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); -H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data); +H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate2_t op, void *op_data, int_f *fields); H5_FCDLL int_f h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, - H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ); -H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info); -H5_FCDLL int_f h5oget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, - int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info); + H5O_iterate2_t op, void *op_data, hid_t_f *lapl_id, int_f *fields ); +H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields); +H5_FCDLL int_f h5oget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5oget_info_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info); + H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5ocopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, - hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, + hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id ); H5_FCDLL int_f h5odecr_refcount_c(hid_t_f *object_id); H5_FCDLL int_f h5oincr_refcount_c(hid_t_f *object_id); H5_FCDLL int_f h5oexists_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id); H5_FCDLL int_f h5oset_comment_c(hid_t_f *object_id, _fcd comment, size_t_f *commentlen); H5_FCDLL int_f h5oset_comment_by_name_c(hid_t_f *object_id, _fcd name, size_t_f *namelen, _fcd comment, size_t_f *commentlen, hid_t_f *lapl_id); -H5_FCDLL int_f h5oopen_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, +H5_FCDLL int_f h5oopen_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id); H5_FCDLL int_f h5oget_comment_c(hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssize_t_f *bufsize); -H5_FCDLL int_f h5oget_comment_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *name_size, +H5_FCDLL int_f h5oget_comment_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *name_size, _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id); +H5_FCDLL int_f h5otoken_cmp_c(hid_t_f *loc_id, H5O_token_t *token1, + H5O_token_t *token2, int_f *cmp_value); /* * Functions from H5Pf.c */ @@ -448,7 +454,6 @@ H5_FCDLL int_f h5pset_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_f H5_FCDLL int_f h5pset_shared_mesg_nindexes_c(hid_t_f *plist_id, int_f *nindexes ); H5_FCDLL int_f h5pset_shared_mesg_index_c(hid_t_f *fcpl_id, int_f *index_num, int_f *mesg_type_flags, int_f *min_mesg_size); H5_FCDLL int_f h5pget_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags); -H5_FCDLL int_f h5pset_libver_bounds_c(hid_t_f *fapl_id, int_f *low, int_f *high); H5_FCDLL int_f h5pset_link_creation_order_c(hid_t_f *gcpl_id, int_f *crt_order_flags); H5_FCDLL int_f h5pget_link_phase_change_c(hid_t_f *gcpl_id, int_f *max_compact, int_f *min_dense ); H5_FCDLL int_f h5pget_obj_track_times_c(hid_t_f *plist_id, int_f *flag); @@ -523,12 +528,12 @@ H5_FCDLL int_f h5open_c(void); H5_FCDLL int_f h5close_c(void); H5_FCDLL int_f h5init_types_c(hid_t_f *types, hid_t_f *floatingtypes, hid_t_f *integertypes); H5_FCDLL int_f h5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f *floatingtypes, int_f *floatinglen, hid_t_f *integertypes, int_f *integerlen); -H5_FCDLL int_f h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, +H5_FCDLL int_f h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, - hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, - int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, + hid_t_f *h5p_flags, int_f *h5p_flags_int, int_f *h5r_flags, + int_f *h5s_flags, hid_t_f *h5s_hid_flags, hsize_t_f *h5s_hsize_flags, int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags, haddr_t_f *h5_haddr_generic_flags); H5_FCDLL int_f h5init1_flags_c(int_f *h5lib_flags); @@ -568,11 +573,11 @@ H5_FCDLL int_f h5ldelete_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *gr H5_FCDLL int_f h5lexists_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, int_f *link_exists); H5_FCDLL int_f h5lget_info_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, - haddr_t_f *address, size_t_f *val_size, - hid_t_f *lapl_id); + H5O_token_t *token, size_t_f *val_size, hid_t_f *lapl_id); H5_FCDLL int_f h5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, int_f *index_field, int_f *order, hsize_t_f *n, - int_f *link_type, int_f *corder_valid, int_f *corder, int_f *cset, haddr_t_f *address, size_t_f *val_size, hid_t_f *lapl_id); + int_f *link_type, int_f *corder_valid, int_f *corder, + int_f *cset, H5O_token_t *token, size_t_f *val_size, hid_t_f *lapl_id); H5_FCDLL int_f h5lis_registered_c(int_f *link_cls_id); H5_FCDLL int_f h5lmove_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, _fcd dest_name, size_t_f *dest_namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); @@ -582,8 +587,8 @@ H5_FCDLL int_f h5lget_name_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f * H5_FCDLL int_f h5lget_val_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, size_t_f *size, void *linkval_buff, hid_t_f *lapl_id) ; -H5_FCDLL int_f h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate_t op, void *op_data ); -H5_FCDLL int_f h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate_t op, void *op_data, hid_t_f *lapl_id); +H5_FCDLL int_f h5literate_c(hid_t_f *group_id, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate2_t op, void *op_data ); +H5_FCDLL int_f h5literate_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, int_f *index_type, int_f *order, hsize_t_f *idx, H5L_iterate2_t op, void *op_data, hid_t_f *lapl_id); #endif /* _H5f90proto_H */ diff --git a/fortran/src/H5fort_type_defines.h.cmake b/fortran/src/H5fort_type_defines.h.cmake new file mode 100644 index 0000000..1aa3181 --- /dev/null +++ b/fortran/src/H5fort_type_defines.h.cmake @@ -0,0 +1,28 @@ +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * Copyright by The HDF Group. * + * All rights reserved. * + * * + * This file is part of HDF5. The full HDF5 copyright notice, including * + * terms governing use, modification, and redistribution, is contained in * + * the COPYING file, which can be found at the root of the source code * + * distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * + * If you do not have access to either file, you may request a copy from * + * help@hdfgroup.org. * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ +/* If you are reading this file and it has a '.h' suffix, it was automatically + * generated from the '.in' version. Make changes there. + */ +#define H5_FORTRAN_NATIVE_INTEGER_KIND @PAC_FORTRAN_NATIVE_INTEGER_KIND@ +#define H5_FORTRAN_NATIVE_INTEGER_SIZEOF @PAC_FORTRAN_NATIVE_INTEGER_SIZEOF@ +#define H5_FORTRAN_NATIVE_REAL_KIND @PAC_FORTRAN_NATIVE_REAL_KIND@ +#define H5_FORTRAN_NATIVE_REAL_SIZEOF @PAC_FORTRAN_NATIVE_REAL_SIZEOF@ +#define H5_FORTRAN_NATIVE_DOUBLE_KIND @PAC_FORTRAN_NATIVE_DOUBLE_KIND@ +#define H5_FORTRAN_NATIVE_DOUBLE_SIZEOF @PAC_FORTRAN_NATIVE_DOUBLE_SIZEOF@ +#define H5_FORTRAN_NUM_INTEGER_KINDS @PAC_FORTRAN_NUM_INTEGER_KINDS@ +#define H5_FORTRAN_INTEGER_KINDS @PAC_FC_ALL_INTEGER_KINDS@ +#define H5_FORTRAN_INTEGER_KINDS_SIZEOF @PAC_FC_ALL_INTEGER_KINDS_SIZEOF@ +#define H5_FORTRAN_REAL_KINDS @PAC_FC_ALL_REAL_KINDS@ +#define H5_FORTRAN_REAL_KINDS_SIZEOF @PAC_FC_ALL_REAL_KINDS_SIZEOF@ +#define H5_HAVE_Fortran_INTEGER_SIZEOF_16 @H5_HAVE_Fortran_INTEGER_SIZEOF_16@ +#define H5_FORTRAN_HAVE_C_LONG_DOUBLE @H5_FORTRAN_HAVE_C_LONG_DOUBLE@ +#define H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE @H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE@ diff --git a/fortran/src/H5fortkit.F90 b/fortran/src/H5fortkit.F90 index f5eba8a..7710a4d 100644 --- a/fortran/src/H5fortkit.F90 +++ b/fortran/src/H5fortkit.F90 @@ -51,8 +51,8 @@ CONTAINS INTEGER :: i INTEGER :: len CHARACTER(LEN=len) :: fstring - CHARACTER(LEN=1), DIMENSION(1:len) :: cstring - + CHARACTER(LEN=1), DIMENSION(1:len) :: cstring + fstring = '' DO i = 1, len IF (cstring(i)(1:1)==CHAR(0)) EXIT diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 7e0b7e8..231b90d 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -143,17 +143,19 @@ void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char int main(void) { int i; - char chrA[32],chrB[32]; + char chrA[64],chrB[64]; int IntKinds[] = H5_FORTRAN_INTEGER_KINDS; int IntKinds_SizeOf[] = H5_FORTRAN_INTEGER_KINDS_SIZEOF; int RealKinds[] = H5_FORTRAN_REAL_KINDS; int RealKinds_SizeOf[] = H5_FORTRAN_REAL_KINDS_SIZEOF; char Real_C_TYPES[10][32]; - + int FORTRAN_NUM_INTEGER_KINDS=H5_FORTRAN_NUM_INTEGER_KINDS; int H5_FORTRAN_NUM_REAL_KINDS; +#if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0 int found_long_double = 0; +#endif /* Open target files */ c_header = fopen(CFILE, "w"); @@ -191,6 +193,8 @@ int main(void) } if(sizeof(size_t) == IntKinds_SizeOf[i]) writeTypedef("size_t", "size_t", IntKinds[i]); + if(sizeof(time_t) == IntKinds_SizeOf[i]) + writeTypedef("time_t", "time_t", IntKinds[i]); if(sizeof(hsize_t) == IntKinds_SizeOf[i]) writeTypedef("hsize_t", "hsize_t", IntKinds[i]); } @@ -204,13 +208,13 @@ int main(void) } else if(sizeof(double) == RealKinds_SizeOf[i]) { writeTypedef("float", "double", RealKinds[i]); - strcpy(Real_C_TYPES[i], "C_DOUBLE"); + strcpy(Real_C_TYPES[i], "C_DOUBLE"); } #if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0 else if(sizeof(long double) == RealKinds_SizeOf[i] && found_long_double == 0) { writeTypedef("float", "long double", RealKinds[i]); strcpy(Real_C_TYPES[i], "C_LONG_DOUBLE"); - found_long_double = 1; + found_long_double = 1; } # ifdef H5_HAVE_FLOAT128 /* Don't select a higher precision than Fortran can support */ @@ -306,6 +310,17 @@ int main(void) return -1; } + /* time_t */ + for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) { + if(IntKinds_SizeOf[i] == H5_SIZEOF_TIME_T) { + writeToFiles("time_t","TIME_T", "time_t_f", IntKinds[i]); + break; + } + if(i == (FORTRAN_NUM_INTEGER_KINDS-1) ) + /* Error: couldn't find a size for time_t */ + return -1; + } + /* int */ writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_KIND); @@ -314,7 +329,7 @@ int main(void) /* Defined different KINDs of integers */ fprintf(fort_header," INTEGER, DIMENSION(1:%d), PARAMETER :: Fortran_INTEGER_AVAIL_KINDS = (/", FORTRAN_NUM_INTEGER_KINDS); - + for(i=0;i<FORTRAN_NUM_INTEGER_KINDS;i++) { fprintf(fort_header,"%d",(int)IntKinds[i]); if(i==FORTRAN_NUM_INTEGER_KINDS-1) { @@ -322,7 +337,7 @@ int main(void) } else { fprintf(fort_header,","); } - + } /* real_4, real_8, real_16 */ @@ -334,8 +349,8 @@ int main(void) for(i=0;i<H5_FORTRAN_NUM_REAL_KINDS;i++) { if (RealKinds[i] > 0) { - sprintf(chrA, "Fortran_REAL_%s", Real_C_TYPES[i]); - sprintf(chrB, "real_%s_f", Real_C_TYPES[i]); + snprintf(chrA, sizeof(chrA), "Fortran_REAL_%s", Real_C_TYPES[i]); + snprintf(chrB, sizeof(chrB), "real_%s_f", Real_C_TYPES[i]); writeToFiles("float",chrA, chrB, RealKinds[i]); } } @@ -401,13 +416,19 @@ int main(void) return -1; } - /* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03' + /* Need the buffer size for the fortran derived type 'hdset_reg_ref_t_f03' * in order to be interoperable with C's structure, the C buffer size * H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4) */ - + fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 ); + /* Need the buffer size for the fortran derived type 'h5o_token_t' + * in order to be interoperable with C's structure. + */ + + fprintf(fort_header, " INTEGER, PARAMETER :: H5O_MAX_TOKEN_SIZE_F = %u\n", H5O_MAX_TOKEN_SIZE); + /* Close files */ endCfile(); endFfile(); diff --git a/fortran/src/HDF5.F90 b/fortran/src/HDF5.F90 index 0370224..fe38b7d 100644 --- a/fortran/src/HDF5.F90 +++ b/fortran/src/HDF5.F90 @@ -38,6 +38,7 @@ MODULE HDF5 USE H5O USE H5P USE H5R + USE H5VL USE H5Z USE H5_gen USE H5LIB diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index a863a67..f8ef02b 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -44,11 +44,11 @@ endif libhdf5_fortran_la_SOURCES=H5f90global.F90 \ H5fortran_types.F90 H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 \ H5Fff.F90 H5Gff.F90 H5Iff.F90 H5Lff.F90 H5Off.F90 H5Pff.F90 H5Rff.F90 H5Sff.F90 \ - H5Tff.F90 H5Zff.F90 H5_gen.F90 H5fortkit.F90 \ + H5Tff.F90 H5VLff.F90 H5Zff.F90 H5_gen.F90 H5fortkit.F90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ H5If.c H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c HDF5.F90 -# HDF5 Fortran library depends on HDF5 Library. +# HDF5 Fortran library depends on HDF5 Library. libhdf5_fortran_la_LIBADD=$(LIBHDF5) # h5fc is generated during configure. @@ -142,7 +142,7 @@ FORTRAN_API=yes # modules they depend upon are actually made. *sigh* H5f90global.lo: $(srcdir)/H5f90global.F90 H5fortran_types.lo H5_buildiface.lo: $(srcdir)/H5_buildiface.F90 -H5_ff.lo: $(srcdir)/H5_ff.F90 H5f90global.lo +H5_ff.lo: $(srcdir)/H5_ff.F90 H5Fff.lo H5f90global.lo H5Aff.lo: $(srcdir)/H5Aff.F90 H5f90global.lo H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5Eff.lo: $(srcdir)/H5Eff.F90 H5f90global.lo @@ -155,6 +155,7 @@ H5Pff.lo: $(srcdir)/H5Pff.F90 H5f90global.lo H5fortkit.lo H5Rff.lo: $(srcdir)/H5Rff.F90 H5f90global.lo H5Sff.lo: $(srcdir)/H5Sff.F90 H5f90global.lo H5Tff.lo: $(srcdir)/H5Tff.F90 H5f90global.lo +H5VLff.lo: $(srcdir)/H5VLff.F90 H5f90global.lo H5Zff.lo: $(srcdir)/H5Zff.F90 H5f90global.lo H5_gen.lo: H5_gen.F90 H5f90global.lo H5Aff.lo H5Dff.lo H5Pff.lo HDF5.lo: $(srcdir)/HDF5.F90 H5f90global.lo H5_ff.lo H5Aff.lo \ diff --git a/fortran/src/README b/fortran/src/README index a258e07..f9316b5 100644 --- a/fortran/src/README +++ b/fortran/src/README @@ -87,7 +87,7 @@ Quick overview of the Fortran APIs to the file, a C program will read it as a 6x4 two-dimensional dataset into memory. The HDF5 C utilities h5dump and h5ls display transposed data, if data is written from a Fortran program. - + * Fortran indices are 1 based. ============================ @@ -105,29 +105,29 @@ Procedure to add a new function Procedure for passing C variables to Fortran --------------------------------------------- -(1) Find the C struct name you are interested in: +(1) Find the C struct name you are interested in: (a) src/H5public.h if it is a generic type, i.e. H5_* or - (b) src/H5*public.h if is a specific type, i.e. H5*_ - + (b) src/H5*public.h if is a specific type, i.e. H5*_ + (2) Put that structure into an array that will be passed to fortran in: (a) fortran/src/H5_f.c (add to nh5init_flags_c subroutine) (b) edit fortran/src/H5f90proto.h and edit nh5init_flags_c interface call - + (3) Edit the function call in fortran/src/H5_ff.F90 - (a) edit the call: FUNCTION h5init_flags_c + (a) edit the call: FUNCTION h5init_flags_c (b) edit h5init_flags_c call in h5open_f to match the number of arguments passing - -(4) add the size of the array and array to fortran/src/H5f90global.F90 + +(4) add the size of the array and array to fortran/src/H5f90global.F90 - must match the size found it H5_f.c -NOTE: To just add a default C value argument, do steps (2a) and (4) +NOTE: To just add a default C value argument, do steps (2a) and (4) Procedure for adding a new file to the repository -------------------------------------------------- -Add the name of the file to the: +Add the name of the file to the: (1) Makefile.am located in the same directory as the newfile (2) CMakeLists.txt located in the same directory as the newfile (3) MANIFEST located in the top level directory diff --git a/fortran/src/h5fc.in b/fortran/src/h5fc.in index 29ef83f..080f7ff 100644 --- a/fortran/src/h5fc.in +++ b/fortran/src/h5fc.in @@ -75,12 +75,12 @@ SHOW="eval" FCBASE="@FC@" FLINKERBASE="@FC@" -# FCFLAGS and LDFLAGS are reserved for use by the script user. +# FCFLAGS and LDFLAGS are reserved for use by the script user. # FLAGS brought from the hdf5 build are put in H5BLD_*FLAGS. -# User's FCFLAGS come after their H5BLD counterparts. User's LDFLAGS come just -# before clibpath, user's LIBS come after $link_objs and before the hdf5 -# libraries in $link_args, followed by any external library paths and libraries +# User's FCFLAGS come after their H5BLD counterparts. User's LDFLAGS come just +# before clibpath, user's LIBS come after $link_objs and before the hdf5 +# libraries in $link_args, followed by any external library paths and libraries # from AM_LDFLAGS, LDFLAGS, AM_LIBS or LIBS carried in from the hdf5 build. # The order of the flags is intended to give precedence to the user's flags. H5BLD_FCFLAGS="@AM_FCFLAGS@ @FCFLAGS@" @@ -358,9 +358,9 @@ if test "x$do_link" = "xyes"; then # module. It's okay if they're included twice in the compile line. link_args="$link_args $H5BLD_LDFLAGS $H5BLD_LIBS" - # User's FCFLAGS come after their H5BLD counterparts. User's LDFLAGS come just - # before clibpath, user's LIBS come after $link_objs and before the hdf5 - # libraries in $link_args, followed by any external library paths and libraries + # User's FCFLAGS come after their H5BLD counterparts. User's LDFLAGS come just + # before clibpath, user's LIBS come after $link_objs and before the hdf5 + # libraries in $link_args, followed by any external library paths and libraries # from AM_LDFLAGS, LDFLAGS, AM_LIBS or LIBS carried in from the hdf5 build. # The order of the flags is intended to give precedence to the user's flags. $SHOW $FLINKER $FCFLAGS $H5BLD_FCFLAGS $F9XSUFFIXFLAG $LDFLAGS $fmodules $link_objs $LIBS $link_args $shared_link diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 3a5a91f..9c69e5a 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -8,6 +8,7 @@ H5LIB_mp_H5GARBAGE_COLLECT_F H5LIB_mp_H5DONT_ATEXIT_F H5LIB_mp_H5KIND_TO_TYPE H5LIB_mp_H5OFFSETOF +H5LIB_mp_H5GMTIME ; H5A H5A_mp_H5AWRITE_CHAR_SCALAR H5A_mp_H5AREAD_CHAR_SCALAR @@ -94,10 +95,14 @@ H5F_mp_H5FOPEN_F H5F_mp_H5FREOPEN_F H5F_mp_H5FGET_CREATE_PLIST_F H5F_mp_H5FGET_ACCESS_PLIST_F +H5F_mp_H5FIS_ACCESSIBLE_F H5F_mp_H5FIS_HDF5_F H5F_mp_H5FGET_NAME_F +H5F_mp_H5FGET_FILENO_F H5F_mp_H5FGET_FILESIZE_F H5F_mp_H5FGET_FILE_IMAGE_F +H5F_mp_H5FGET_DSET_NO_ATTRS_HINT_F +H5F_mp_H5FSET_DSET_NO_ATTRS_HINT_F ; H5G H5G_mp_H5GOPEN_F H5G_mp_H5GCREATE_F @@ -170,7 +175,7 @@ H5O_mp_H5OGET_COMMENT_F H5O_mp_H5OGET_COMMENT_BY_NAME_F H5O_mp_H5OINCR_REFCOUNT_F H5O_mp_H5OLINK_F -H5O_mp_H5OOPEN_BY_ADDR_F +H5O_mp_H5OOPEN_BY_TOKEN_F H5O_mp_H5OOPEN_BY_IDX_F H5O_mp_H5OOPEN_F H5O_mp_H5OSET_COMMENT_F @@ -180,6 +185,7 @@ H5O_mp_H5OGET_INFO_BY_NAME_F H5O_mp_H5OGET_INFO_F H5O_mp_H5OVISIT_BY_NAME_F H5O_mp_H5OVISIT_F +H5O_mp_H5OTOKEN_CMP_F ; H5P H5P_mp_H5PCREATE_F H5P_mp_H5PSET_PRESERVE_F @@ -282,6 +288,7 @@ H5P_mp_H5PSET_ATTR_CREATION_ORDER_F H5P_mp_H5PSET_SHARED_MESG_NINDEXES_F H5P_mp_H5PSET_SHARED_MESG_INDEX_F H5P_mp_H5PGET_ATTR_CREATION_ORDER_F +H5P_mp_H5PGET_LIBVER_BOUNDS_F H5P_mp_H5PSET_LIBVER_BOUNDS_F H5P_mp_H5PSET_LINK_CREATION_ORDER_F H5P_mp_H5PGET_LINK_PHASE_CHANGE_F @@ -328,6 +335,10 @@ H5P_mp_H5PGET_VIRTUAL_VSPACE_F H5P_mp_H5PGET_VIRTUAL_SRCSPACE_F H5P_mp_H5PGET_VIRTUAL_FILENAME_F H5P_mp_H5PGET_VIRTUAL_DSETNAME_F +H5P_mp_H5PGET_DSET_NO_ATTRS_HINT_F +H5P_mp_H5PSET_DSET_NO_ATTRS_HINT_F +H5P_mp_H5PSET_VOL_F +H5P_mp_H5PGET_VOL_ID_F ; Parallel @H5_NOPAREXP@H5P_mp_H5PSET_FAPL_MPIO_F @H5_NOPAREXP@H5P_mp_H5PGET_FAPL_MPIO_F @@ -445,6 +456,17 @@ H5T_mp_H5TGET_NATIVE_TYPE_F H5T_mp_H5TCONVERT_F H5T_mp_H5TENUM_INSERT_F90 H5T_mp_H5TENUM_INSERT_F03 +; H5VL +H5VL_mp_H5VLREGISTER_CONNECTOR_BY_NAME_F +H5VL_mp_H5VLREGISTER_CONNECTOR_BY_VALUE_F +H5VL_mp_H5VLIS_CONNECTOR_REGISTERED_BY_NAME_F +H5VL_mp_H5VLIS_CONNECTOR_REGISTERED_BY_VALUE_F +H5VL_mp_H5VLGET_CONNECTOR_ID_F +H5VL_mp_H5VLGET_CONNECTOR_ID_BY_NAME_F +H5VL_mp_H5VLGET_CONNECTOR_ID_BY_VALUE_F +H5VL_mp_H5VLGET_CONNECTOR_NAME_F +H5VL_mp_H5VLCLOSE_F +H5VL_mp_H5VLUNREGISTER_CONNECTOR_F ; H5Z H5Z_mp_H5ZUNREGISTER_F H5Z_mp_H5ZFILTER_AVAIL_F diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 1661a10..ff7001b 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -1,126 +1,123 @@ -cmake_minimum_required (VERSION 3.2.2) -PROJECT (HDF5_FORTRAN_TESTS C CXX Fortran) - -#----------------------------------------------------------------------------- -# Setup include Directories -#----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) +cmake_minimum_required (VERSION 3.12) +project (HDF5_FORTRAN_TESTS C Fortran) #----------------------------------------------------------------------------- # Setup the Fortran auto-detection utilities # H5_test_buildiface.F90 used to generate various KIND test interfaces #----------------------------------------------------------------------------- -add_executable (H5_test_buildiface - ${HDF5_F90_SRC_DIR}/test/H5_test_buildiface.F90 - ) - -if (WIN32 AND MSVC) - if (BUILD_SHARED_LIBS) - set_target_properties (H5_test_buildiface - PROPERTIES - COMPILE_FLAGS "/MT" - ) - endif () - set_target_properties (H5_test_buildiface - PROPERTIES - LINK_FLAGS "/SUBSYSTEM:CONSOLE" - ) -endif () +add_executable (H5_test_buildiface ${HDF5_F90_SRC_DIR}/test/H5_test_buildiface.F90) +target_include_directories (H5_test_buildiface + PRIVATE + ${HDF5_BINARY_DIR} ${HDF5_F90_BINARY_DIR} +) +#if (BUILD_SHARED_LIBS) +# target_compile_definitions(H5_test_buildiface +# PRIVATE $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:/MT> +# ) +#endif () +if(MSVC) + set_property(TARGET H5_test_buildiface PROPERTY COMPILE_FLAGS "/MT") +endif() +#set_property(TARGET H5_test_buildiface APPEND PROPERTY +# LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE"> +#) +if(MSVC) + set_property(TARGET H5_test_buildiface PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE") +endif() set_target_properties (H5_test_buildiface PROPERTIES LINKER_LANGUAGE Fortran Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY} ) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - file (MAKE_DIRECTORY "${HDF5_F90_BINARY_DIR}/shared") - if (WIN32) - set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared/${CMAKE_BUILD_TYPE}) - else () - set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - endif () -endif () -if (WIN32) - set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static/${CMAKE_BUILD_TYPE}) +if (NOT BUILD_SHARED_LIBS) + file (MAKE_DIRECTORY "${HDF5_FORTRAN_TESTS_BINARY_DIR}/static") + set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static/${HDF_CFG_BUILD_TYPE}) else () - set (MOD_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + file (MAKE_DIRECTORY "${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared") + set (MODSH_BUILD_DIR ${CMAKE_Fortran_MODULE_DIRECTORY}/shared/${HDF_CFG_BUILD_TYPE}) endif () -INCLUDE_DIRECTORIES (${CMAKE_Fortran_MODULE_DIRECTORY} ${MOD_BUILD_DIR}) - #----------------------------------------------------------------------------- # Add Test Lib #----------------------------------------------------------------------------- -add_library (${HDF5_F90_C_TEST_LIB_TARGET} STATIC t.c) -set_source_files_properties (t.c PROPERTIES LANGUAGE C) -TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIB_TARGET} STATIC " " " ") -target_link_libraries (${HDF5_F90_C_TEST_LIB_TARGET} - ${HDF5_F90_C_LIB_TARGET} - ${HDF5_TEST_LIB_TARGET} -) -H5_SET_LIB_OPTIONS (${HDF5_F90_C_TEST_LIB_TARGET} ${HDF5_F90_C_TEST_LIB_NAME} STATIC) -set_target_properties (${HDF5_F90_C_TEST_LIB_TARGET} PROPERTIES - FOLDER libraries/test/fortran - LINKER_LANGUAGE C - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" -) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) +if (NOT BUILD_SHARED_LIBS) + add_library (${HDF5_F90_C_TEST_LIB_TARGET} STATIC t.c) + set_source_files_properties (t.c PROPERTIES LANGUAGE C) + target_include_directories (${HDF5_F90_C_TEST_LIB_TARGET} + PRIVATE "${HDF5_SRC_DIR};${HDF5_BINARY_DIR};${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static;$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_C_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + ) + target_compile_options(${HDF5_F90_C_TEST_LIB_TARGET} PRIVATE "${HDF5_CMAKE_C_FLAGS}") + TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIB_TARGET} STATIC) + target_link_libraries (${HDF5_F90_C_TEST_LIB_TARGET} + PRIVATE ${HDF5_F90_C_LIB_TARGET} + PUBLIC ${HDF5_TEST_LIB_TARGET} + ) + H5_SET_LIB_OPTIONS (${HDF5_F90_C_TEST_LIB_TARGET} ${HDF5_F90_C_TEST_LIB_NAME} STATIC 0) + set_target_properties (${HDF5_F90_C_TEST_LIB_TARGET} PROPERTIES + FOLDER libraries/test/fortran + LINKER_LANGUAGE C + ) +else () add_library (${HDF5_F90_C_TEST_LIBSH_TARGET} SHARED t.c) - TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIBSH_TARGET} SHARED " " " ") + target_include_directories (${HDF5_F90_C_TEST_LIBSH_TARGET} + PRIVATE "${HDF5_SRC_DIR};${HDF5_BINARY_DIR};${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared;$<$<BOOL:${HDF5_ENABLE_PARALLEL}>:${MPI_C_INCLUDE_DIRS}>" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" + ) + target_compile_options(${HDF5_F90_C_TEST_LIBSH_TARGET} PRIVATE "${HDF5_CMAKE_C_FLAGS}") + target_compile_definitions(${HDF5_F90_C_TEST_LIBSH_TARGET} PUBLIC "H5_BUILT_AS_DYNAMIC_LIB") + TARGET_C_PROPERTIES (${HDF5_F90_C_TEST_LIBSH_TARGET} SHARED) target_link_libraries (${HDF5_F90_C_TEST_LIBSH_TARGET} - ${HDF5_F90_C_LIBSH_TARGET} - ${HDF5_TEST_LIBSH_TARGET} + PRIVATE ${HDF5_F90_C_LIBSH_TARGET} + PUBLIC ${HDF5_TEST_LIBSH_TARGET} ) - H5_SET_LIB_OPTIONS (${HDF5_F90_C_TEST_LIBSH_TARGET} ${HDF5_F90_C_TEST_LIB_NAME} SHARED ${HDF5_PACKAGE_SOVERSION}) + H5_SET_LIB_OPTIONS (${HDF5_F90_C_TEST_LIBSH_TARGET} ${HDF5_F90_C_TEST_LIB_NAME} SHARED "F") set_target_properties (${HDF5_F90_C_TEST_LIBSH_TARGET} PROPERTIES FOLDER libraries/test/fortran LINKER_LANGUAGE C - COMPILE_DEFINITIONS "H5_BUILT_AS_DYNAMIC_LIB" - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" - INTERFACE_COMPILE_DEFINITIONS H5_BUILT_AS_DYNAMIC_LIB=1 ) endif () -set (CMD $<TARGET_FILE:H5_test_buildiface>) -add_custom_command ( - OUTPUT ${HDF5_F90_BINARY_DIR}/tf_gen.F90 - COMMAND ${CMD} - WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR} - DEPENDS H5_test_buildiface - COMMENT "Generating the tf_gen.F90 file" -) -add_custom_target (H5testgen ALL - DEPENDS ${HDF5_F90_BINARY_DIR}/tf_gen.F90 -) -set_source_files_properties (${HDF5_F90_BINARY_DIR}/tf_gen.F90 PROPERTIES GENERATED TRUE) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - set (CMDSH $<TARGET_FILE:H5_test_buildiface>) +if (NOT BUILD_SHARED_LIBS) + add_custom_command ( + OUTPUT ${HDF5_FORTRAN_TESTS_BINARY_DIR}/static/tf_gen.F90 + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:H5_test_buildiface> + WORKING_DIRECTORY ${HDF5_FORTRAN_TESTS_BINARY_DIR}/static + DEPENDS H5_test_buildiface + COMMENT "Generating the tf_gen.F90 file" + ) + add_custom_target (H5testgen ALL + DEPENDS ${HDF5_FORTRAN_TESTS_BINARY_DIR}/static/tf_gen.F90 + ) + set_source_files_properties (${HDF5_FORTRAN_TESTS_BINARY_DIR}/static/tf_gen.F90 PROPERTIES GENERATED TRUE) +else () add_custom_command ( - OUTPUT ${HDF5_F90_BINARY_DIR}/shared/tf_gen.F90 - COMMAND ${CMDSH} - WORKING_DIRECTORY ${HDF5_F90_BINARY_DIR}/shared + OUTPUT ${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared/tf_gen.F90 + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:H5_test_buildiface> + WORKING_DIRECTORY ${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared DEPENDS H5_test_buildiface COMMENT "Generating the tf_gen.F90 shared file" ) add_custom_target (H5testgenSH ALL - DEPENDS ${HDF5_F90_BINARY_DIR}/shared/tf_gen.F90 + DEPENDS ${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared/tf_gen.F90 ) - set_source_files_properties (${HDF5_F90_BINARY_DIR}/shared/tf_gen.F90 PROPERTIES GENERATED TRUE) + set_source_files_properties (${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared/tf_gen.F90 PROPERTIES GENERATED TRUE) endif () -set (HDF5_F90_TF_SOURCES - # generated files - ${HDF5_F90_BINARY_DIR}/tf_gen.F90 +if (NOT BUILD_SHARED_LIBS) + set (HDF5_F90_TF_SOURCES + # generated files + ${HDF5_FORTRAN_TESTS_BINARY_DIR}/static/tf_gen.F90 - # normal distribution - tf.F90 -) -set_source_files_properties (${HDF5_F90_TF_SOURCES} PROPERTIES LANGUAGE Fortran) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) + # normal distribution + tf.F90 + ) + set_source_files_properties (${HDF5_F90_TF_SOURCES} PROPERTIES LANGUAGE Fortran) +else () set (HDF5_F90_TF_SOURCES_SHARED # generated file - ${HDF5_F90_BINARY_DIR}/shared/tf_gen.F90 + ${HDF5_FORTRAN_TESTS_BINARY_DIR}/shared/tf_gen.F90 # normal distribution tf.F90 @@ -128,55 +125,57 @@ if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) set_source_files_properties (${HDF5_F90_TF_SOURCES_SHARED} PROPERTIES LANGUAGE Fortran) endif () -add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC ${HDF5_F90_TF_SOURCES}) -TARGET_FORTRAN_PROPERTIES (${HDF5_F90_TEST_LIB_TARGET} STATIC " " " ") -target_link_libraries (${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_C_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} -) -H5_SET_LIB_OPTIONS (${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_TEST_LIB_NAME} STATIC) -target_include_directories (${HDF5_F90_TEST_LIB_TARGET} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) -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}/static -) -if (WIN32) - set_property (TARGET ${HDF5_F90_TEST_LIB_TARGET} APPEND PROPERTY - COMPILE_DEFINITIONS "HDF5F90_WINDOWS" - ) -endif () -add_dependencies(${HDF5_F90_TEST_LIB_TARGET} H5testgen) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) +if (NOT BUILD_SHARED_LIBS) + add_library (${HDF5_F90_TEST_LIB_TARGET} STATIC ${HDF5_F90_TF_SOURCES}) + target_include_directories (${HDF5_F90_TEST_LIB_TARGET} + PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include/static>" + ) + target_compile_options(${HDF5_F90_TEST_LIB_TARGET} PRIVATE "${HDF5_CMAKE_Fortran_FLAGS}") + target_compile_definitions(${HDF5_F90_TEST_LIB_TARGET} + PRIVATE + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:HDF5F90_WINDOWS> + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> + ) + target_link_libraries (${HDF5_F90_TEST_LIB_TARGET} PUBLIC ${HDF5_F90_C_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET}) +# set_property(TARGET ${HDF5_F90_TEST_LIB_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET ${HDF5_F90_TEST_LIB_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) + if(MSVC) + set_property(TARGET ${HDF5_F90_TEST_LIB_TARGET} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") + endif() + set_target_properties (${HDF5_F90_TEST_LIB_TARGET} PROPERTIES + FOLDER libraries/test/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + H5_SET_LIB_OPTIONS (${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_TEST_LIB_NAME} STATIC 0) + add_dependencies(${HDF5_F90_TEST_LIB_TARGET} H5testgen) +else () add_library (${HDF5_F90_TEST_LIBSH_TARGET} SHARED ${HDF5_F90_TF_SOURCES_SHARED}) - set (SHARED_LINK_FLAGS " ") - if (WIN32 AND MSVC) - set (SHARED_LINK_FLAGS "/DLL") - endif () - TARGET_FORTRAN_PROPERTIES (${HDF5_F90_TEST_LIBSH_TARGET} SHARED " " ${SHARED_LINK_FLAGS}) - target_link_libraries (${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_F90_C_TEST_LIBSH_TARGET} - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} + target_include_directories (${HDF5_F90_TEST_LIBSH_TARGET} + PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared" + INTERFACE "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include/shared>" ) - H5_SET_LIB_OPTIONS (${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_TEST_LIB_NAME} SHARED ${HDF5_PACKAGE_SOVERSION}) - target_include_directories (${HDF5_F90_TEST_LIBSH_TARGET} PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) + target_compile_options(${HDF5_F90_TEST_LIBSH_TARGET} PRIVATE "${HDF5_CMAKE_Fortran_FLAGS}") + target_compile_definitions(${HDF5_F90_TEST_LIBSH_TARGET} + PUBLIC "H5_BUILT_AS_DYNAMIC_LIB" + PRIVATE + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:BUILD_HDF5_TEST_DLL;HDF5F90_WINDOWS> + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> + ) + target_link_libraries (${HDF5_F90_TEST_LIBSH_TARGET} PUBLIC ${HDF5_F90_C_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET}) +# set_property(TARGET ${HDF5_F90_TEST_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +# set_property(TARGET ${HDF5_F90_TEST_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +# set_property(TARGET ${HDF5_F90_TEST_LIBSH_TARGET} APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-DLL">) + if(MSVC) + set_property(TARGET ${HDF5_F90_TEST_LIBSH_TARGET} PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS} -DLL") + endif() set_target_properties (${HDF5_F90_TEST_LIBSH_TARGET} PROPERTIES FOLDER libraries/test/fortran LINKER_LANGUAGE Fortran - COMPILE_DEFINITIONS "H5_BUILT_AS_DYNAMIC_LIB" - INTERFACE_INCLUDE_DIRECTORIES "$<INSTALL_INTERFACE:$<INSTALL_PREFIX>/include>" - INTERFACE_COMPILE_DEFINITIONS H5_BUILT_AS_DYNAMIC_LIB=1 Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - if (WIN32) - set_property (TARGET ${HDF5_F90_TEST_LIBSH_TARGET} APPEND PROPERTY - COMPILE_DEFINITIONS "BUILD_HDF5_TEST_DLL;HDF5F90_WINDOWS" - ) - endif () + H5_SET_LIB_OPTIONS (${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_TEST_LIB_NAME} SHARED "F") add_dependencies(${HDF5_F90_TEST_LIBSH_TARGET} H5testgenSH) endif () @@ -202,59 +201,34 @@ add_executable (testhdf5_fortran tH5Z.F90 tHDF5.F90 ) -TARGET_NAMING (testhdf5_fortran STATIC) -TARGET_FORTRAN_PROPERTIES (testhdf5_fortran STATIC " " " ") -target_link_libraries (testhdf5_fortran - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} +target_compile_options(testhdf5_fortran + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -if (WIN32 AND MSVC) - target_link_libraries (testhdf5_fortran "ws2_32.lib") -endif () -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}/static -) -add_dependencies (testhdf5_fortran ${HDF5_F90_TEST_LIB_TARGET}) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (testhdf5_fortran-shared - fortranlib_test.F90 - tH5A.F90 - tH5D.F90 - tH5E.F90 - tH5F.F90 - tH5G.F90 - tH5I.F90 - tH5P.F90 - tH5R.F90 - tH5S.F90 - tH5Sselect.F90 - tH5T.F90 - tH5VL.F90 - tH5Z.F90 - tHDF5.F90 - ) - TARGET_NAMING (testhdf5_fortran-shared SHARED) - TARGET_FORTRAN_PROPERTIES (testhdf5_fortran-shared SHARED " " " ") - target_link_libraries (testhdf5_fortran-shared - ${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} +#set_property(TARGET testhdf5_fortran APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET testhdf5_fortran APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET testhdf5_fortran PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (testhdf5_fortran PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static") + target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (testhdf5_fortran PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static ) - if (WIN32 AND MSVC) - target_link_libraries (testhdf5_fortran-shared "ws2_32.lib") - endif () - target_include_directories (testhdf5_fortran-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (testhdf5_fortran-shared PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER test/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + add_dependencies (testhdf5_fortran ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (testhdf5_fortran PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared") + target_link_libraries (testhdf5_fortran PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (testhdf5_fortran PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - add_dependencies (testhdf5_fortran-shared ${HDF5_F90_TEST_LIBSH_TARGET}) + add_dependencies (testhdf5_fortran ${HDF5_F90_TEST_LIBSH_TARGET}) endif () #-- Adding test for testhdf5_fortran_1_8 @@ -266,50 +240,34 @@ add_executable (testhdf5_fortran_1_8 tH5MISC_1_8.F90 tHDF5_1_8.F90 ) -TARGET_NAMING (testhdf5_fortran_1_8 STATIC) -TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8 STATIC " " " ") -target_link_libraries (testhdf5_fortran_1_8 - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} +target_compile_options(testhdf5_fortran_1_8 + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -if (WIN32 AND MSVC) - target_link_libraries (testhdf5_fortran_1_8 "ws2_32.lib") -endif () -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}/static -) -add_dependencies (testhdf5_fortran_1_8 ${HDF5_F90_TEST_LIB_TARGET}) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (testhdf5_fortran_1_8-shared - fortranlib_test_1_8.F90 - tH5O.F90 - tH5A_1_8.F90 - tH5G_1_8.F90 - tH5MISC_1_8.F90 - tHDF5_1_8.F90 - ) - TARGET_NAMING (testhdf5_fortran_1_8-shared SHARED) - TARGET_FORTRAN_PROPERTIES (testhdf5_fortran_1_8-shared SHARED " " " ") - target_link_libraries (testhdf5_fortran_1_8-shared - ${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} +#set_property(TARGET testhdf5_fortran_1_8 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET testhdf5_fortran_1_8 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET testhdf5_fortran_1_8 PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (testhdf5_fortran_1_8 PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static") + target_link_libraries (testhdf5_fortran_1_8 PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (testhdf5_fortran_1_8 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static ) - if (WIN32 AND MSVC) - target_link_libraries (testhdf5_fortran_1_8-shared "ws2_32.lib") - endif () - target_include_directories (testhdf5_fortran_1_8-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (testhdf5_fortran_1_8-shared PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER test/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + add_dependencies (testhdf5_fortran_1_8 ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (testhdf5_fortran_1_8 PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared") + target_link_libraries (testhdf5_fortran_1_8 PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (testhdf5_fortran_1_8 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - add_dependencies (testhdf5_fortran_1_8-shared ${HDF5_F90_TEST_LIBSH_TARGET}) + add_dependencies (testhdf5_fortran_1_8 ${HDF5_F90_TEST_LIBSH_TARGET}) endif () #-- Adding test for fortranlib_test_F03 @@ -323,135 +281,132 @@ add_executable (fortranlib_test_F03 tH5T_F03.F90 tHDF5_F03.F90 ) -TARGET_NAMING (fortranlib_test_F03 STATIC) -TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03 STATIC " " " ") -target_link_libraries (fortranlib_test_F03 - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} -) -if (WIN32 AND MSVC) - target_link_libraries (fortranlib_test_F03 "ws2_32.lib") -endif () -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}/static +target_compile_options(fortranlib_test_F03 + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -add_dependencies (fortranlib_test_F03 ${HDF5_F90_TEST_LIB_TARGET}) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (fortranlib_test_F03-shared - fortranlib_test_F03.F90 - tH5E_F03.F90 - tH5F_F03.F90 - tH5L_F03.F90 - tH5O_F03.F90 - tH5P_F03.F90 - tH5T_F03.F90 - tHDF5_F03.F90 - ) - TARGET_NAMING (fortranlib_test_F03-shared SHARED) - TARGET_FORTRAN_PROPERTIES (fortranlib_test_F03-shared SHARED " " " ") - target_link_libraries (fortranlib_test_F03-shared - ${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} +#set_property(TARGET fortranlib_test_F03 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET fortranlib_test_F03 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET fortranlib_test_F03 PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (fortranlib_test_F03 PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/static;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/static") + target_link_libraries (fortranlib_test_F03 PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fortranlib_test_F03 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static ) - if (WIN32 AND MSVC) - target_link_libraries (fortranlib_test_F03-shared "ws2_32.lib") - endif () - - target_include_directories (fortranlib_test_F03-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (fortranlib_test_F03-shared PROPERTIES + add_dependencies (fortranlib_test_F03 ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (fortranlib_test_F03 PRIVATE "${CMAKE_Fortran_MODULE_DIRECTORY}/shared;${HDF5_F90_BINARY_DIR};${HDF5_F90_BINARY_DIR}/shared") + target_link_libraries (fortranlib_test_F03 PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fortranlib_test_F03 PROPERTIES LINKER_LANGUAGE Fortran FOLDER test/fortran Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - add_dependencies (fortranlib_test_F03-shared ${HDF5_F90_TEST_LIBSH_TARGET}) + add_dependencies (fortranlib_test_F03 ${HDF5_F90_TEST_LIBSH_TARGET}) endif () #-- Adding test for fflush1 add_executable (fflush1 fflush1.F90) -TARGET_NAMING (fflush1 STATIC) -TARGET_FORTRAN_PROPERTIES (fflush1 STATIC " " " ") -target_link_libraries (fflush1 - ${HDF5_F90_LIB_TARGET} - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_LIB_TARGET} -) -if (WIN32 AND MSVC) - target_link_libraries (fflush1 "ws2_32.lib") -endif () -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}/static +target_compile_options(fflush1 + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -add_dependencies (fflush1 ${HDF5_F90_TEST_LIB_TARGET}) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (fflush1-shared fflush1.F90) - TARGET_NAMING (fflush1-shared SHARED) - TARGET_FORTRAN_PROPERTIES (fflush1-shared SHARED " " " ") - target_link_libraries (fflush1-shared - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} +#set_property(TARGET fflush1 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET fflush1 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET fflush1 PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (fflush1 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + target_link_libraries (fflush1 PRIVATE ${HDF5_F90_LIB_TARGET} ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fflush1 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static ) - if (WIN32 AND MSVC) - target_link_libraries (fflush1-shared "ws2_32.lib") - endif () - target_include_directories (fflush1-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (fflush1-shared PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER test/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + add_dependencies (fflush1 ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (fflush1 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) + target_link_libraries (fflush1 PRIVATE ${HDF5_F90_LIBSH_TARGET} ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fflush1 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - add_dependencies (fflush1-shared ${HDF5_F90_TEST_LIBSH_TARGET}) + add_dependencies (fflush1 ${HDF5_F90_TEST_LIBSH_TARGET}) endif () #-- Adding test for fflush2 add_executable (fflush2 fflush2.F90) -TARGET_NAMING (fflush2 STATIC) -TARGET_FORTRAN_PROPERTIES (fflush2 STATIC " " " ") -target_link_libraries (fflush2 - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} +target_compile_options (fflush2 + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -if (WIN32 AND MSVC) - target_link_libraries (fflush2 "ws2_32.lib") +#set_property(TARGET fflush2 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET fflush2 APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET fflush2 PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (fflush2 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + target_link_libraries (fflush2 PRIVATE ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fflush2 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) + add_dependencies (fflush2 ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (fflush2 PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) + target_link_libraries (fflush2 PRIVATE ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (fflush2 PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + ) + add_dependencies (fflush2 ${HDF5_F90_TEST_LIBSH_TARGET}) endif () -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}/static -) -add_dependencies (fflush2 ${HDF5_F90_TEST_LIB_TARGET}) -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_executable (fflush2-shared fflush2.F90) - TARGET_NAMING (fflush2-shared SHARED) - TARGET_FORTRAN_PROPERTIES (fflush2-shared SHARED " " " ") - target_link_libraries (fflush2-shared - ${HDF5_F90_TEST_LIBSH_TARGET} - ${HDF5_F90_LIBSH_TARGET} - ${HDF5_LIBSH_TARGET} +#-- Adding test for vol_connector +add_executable (vol_connector vol_connector.F90) +target_compile_options(vol_connector + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> +) +#set_property(TARGET vol_connector APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET vol_connector APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET vol_connector PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() +if (NOT BUILD_SHARED_LIBS) + target_include_directories (vol_connector PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) + target_link_libraries (vol_connector PRIVATE ${HDF5_F90_LIB_TARGET} ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_LIB_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (vol_connector PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static ) - if (WIN32 AND MSVC) - target_link_libraries (fflush2-shared "ws2_32.lib") - endif () - target_include_directories (fflush2-shared PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) - set_target_properties (fflush2-shared PROPERTIES - LINKER_LANGUAGE Fortran - FOLDER test/fortran - Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + add_dependencies (vol_connector ${HDF5_F90_TEST_LIB_TARGET}) +else () + target_include_directories (vol_connector PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) + target_link_libraries (vol_connector PRIVATE ${HDF5_F90_LIBSH_TARGET} ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} $<$<PLATFORM_ID:Windows>:ws2_32.lib>) + set_target_properties (vol_connector PROPERTIES + LINKER_LANGUAGE Fortran + FOLDER test/fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared ) - add_dependencies (fflush2-shared ${HDF5_F90_TEST_LIBSH_TARGET}) + add_dependencies (vol_connector ${HDF5_F90_TEST_LIBSH_TARGET}) endif () -include (CMakeTests.cmake) +if (HDF5_TEST_FORTRAN AND HDF5_TEST_SERIAL) + include (CMakeTests.cmake) +endif () diff --git a/fortran/test/CMakeTests.cmake b/fortran/test/CMakeTests.cmake index e171e7c..df5c76c 100644 --- a/fortran/test/CMakeTests.cmake +++ b/fortran/test/CMakeTests.cmake @@ -15,58 +15,55 @@ ### T E S T I N G ### ############################################################################## ############################################################################## -if (BUILD_SHARED_LIBS) - file (MAKE_DIRECTORY "${PROJECT_BINARY_DIR}/fshared") -endif () + +set (testhdf5_fortran_CLEANFILES + a.h5 + b.h5 + c.h5 + d.h5 + dsetf_F03.h5 + enum1.h5 + extern_1a.raw + extern_2a.raw + extern_3a.raw + extern_4a.raw + extren_raw.raw + get_info.h5 + nbit.h5 + t_array_F03.h5 + t_bit_F03.h5 + t_controlchar_F03.h5 + t_enum_F03.h5 + t_objref_F03.h5 + t_opaque_F03.h5 + t_regref_F03.h5 + t_string_F03.h5 + t_vlen_F03.h5 + t_vlstring_F03.h5 + t_vlstringrw_F03.h5 + tarray1.h5 + tarray2.h5 + tarray3.h5 + test_create.h5 + tget_file_image.h5 + th5o_ref.h5 + titerate.h5 + vds.h5 + visit.h5 +) # Remove any output file left over from previous test run add_test ( NAME FORTRAN_testhdf5-clear-objects - COMMAND ${CMAKE_COMMAND} - -E remove - a.h5 - b.h5 - c.h5 - d.h5 - dsetf_F03.h5 - enum1.h5 - extern_1a.raw - extern_2a.raw - extern_3a.raw - extern_4a.raw - extren_raw.raw - get_info.h5 - nbit.h5 - t_array_F03.h5 - t_bit_F03.h5 - t_controlchar_F03.h5 - t_enum_F03.h5 - t_objref_F03.h5 - t_opaque_F03.h5 - t_regref_F03.h5 - t_string_F03.h5 - t_vlen_F03.h5 - t_vlstring_F03.h5 - t_vlstringrw_F03.h5 - tarray1.h5 - tarray2.h5 - tarray3.h5 - test_create.h5 - tget_file_image.h5 - th5o_ref.h5 - titerate.h5 - vds.h5 - visit.h5 + COMMAND ${CMAKE_COMMAND} -E remove ${testhdf5_fortran_CLEANFILES} ) -if (NOT "${last_test}" STREQUAL "") - set_tests_properties (FORTRAN_testhdf5-clear-objects PROPERTIES DEPENDS ${last_test}) -endif () -set (last_test "FORTRAN_testhdf5-clear-objects") +set_tests_properties (FORTRAN_testhdf5-clear-objects PROPERTIES FIXTURES_SETUP clear_testhdf5_fortran) if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_testhdf5_fortran COMMAND $<TARGET_FILE:testhdf5_fortran>) + add_test (NAME FORTRAN_testhdf5_fortran COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:testhdf5_fortran>) else () add_test (NAME FORTRAN_testhdf5_fortran COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" -D "TEST_PROGRAM=$<TARGET_FILE:testhdf5_fortran>" -D "TEST_ARGS:STRING=" -D "TEST_EXPECT=0" @@ -80,13 +77,16 @@ else () ) endif () #set_tests_properties (FORTRAN_testhdf5_fortran PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") -set_tests_properties (FORTRAN_testhdf5_fortran PROPERTIES DEPENDS FORTRAN_testhdf5-clear-objects) +set_tests_properties (FORTRAN_testhdf5_fortran PROPERTIES + FIXTURES_REQUIRED clear_testhdf5_fortran +) #-- Adding test for testhdf5_fortran_1_8 if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_testhdf5_fortran_1_8 COMMAND $<TARGET_FILE:testhdf5_fortran_1_8>) + add_test (NAME FORTRAN_testhdf5_fortran_1_8 COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:testhdf5_fortran_1_8>) else () add_test (NAME FORTRAN_testhdf5_fortran_1_8 COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" -D "TEST_PROGRAM=$<TARGET_FILE:testhdf5_fortran_1_8>" -D "TEST_ARGS:STRING=" -D "TEST_EXPECT=0" @@ -100,147 +100,72 @@ else () ) endif () #set_tests_properties (FORTRAN_testhdf5_fortran_1_8 PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") -set_tests_properties (FORTRAN_testhdf5_fortran_1_8 PROPERTIES DEPENDS FORTRAN_testhdf5_fortran) +set_tests_properties (FORTRAN_testhdf5_fortran_1_8 PROPERTIES + DEPENDS FORTRAN_testhdf5_fortran + FIXTURES_REQUIRED clear_testhdf5_fortran +) #-- Adding test for fortranlib_test_F03 -if (HDF5_ENABLE_F2003) - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_fortranlib_test_F03 COMMAND $<TARGET_FILE:fortranlib_test_F03>) - else () - add_test (NAME FORTRAN_fortranlib_test_F03 COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:fortranlib_test_F03>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_REGEX= 0 error.s." - -D "TEST_MATCH= 0 error(s)" - -D "TEST_OUTPUT=fortranlib_test_F03.txt" - #-D "TEST_REFERENCE=fortranlib_test_F03.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () +if (HDF5_ENABLE_USING_MEMCHECKER) + add_test (NAME FORTRAN_fortranlib_test_F03 COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:fortranlib_test_F03>) +else () + add_test (NAME FORTRAN_fortranlib_test_F03 COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" + -D "TEST_PROGRAM=$<TARGET_FILE:fortranlib_test_F03>" + -D "TEST_ARGS:STRING=" + -D "TEST_EXPECT=0" + -D "TEST_SKIP_COMPARE=TRUE" + -D "TEST_REGEX= 0 error.s." + -D "TEST_MATCH= 0 error(s)" + -D "TEST_OUTPUT=fortranlib_test_F03.txt" + #-D "TEST_REFERENCE=fortranlib_test_F03.out" + -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" + -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" + ) +endif () # set_tests_properties (FORTRAN_fortranlib_test_F03 PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") - set_tests_properties (FORTRAN_fortranlib_test_F03 PROPERTIES DEPENDS FORTRAN_testhdf5_fortran_1_8) +set_tests_properties (FORTRAN_fortranlib_test_F03 PROPERTIES + DEPENDS FORTRAN_testhdf5_fortran_1_8 + FIXTURES_REQUIRED clear_testhdf5_fortran +) + +#-- Adding test for vol_connector +if (HDF5_ENABLE_USING_MEMCHECKER) + add_test (NAME FORTRAN_vol_connector COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:vol_connector>) +else () + add_test (NAME FORTRAN_vol_connector COMMAND "${CMAKE_COMMAND}" + -D "TEST_EMULATOR=${CMAKE_CROSSCOMPILING_EMULATOR}" + -D "TEST_PROGRAM=$<TARGET_FILE:vol_connector>" + -D "TEST_ARGS:STRING=" + -D "TEST_EXPECT=0" + -D "TEST_SKIP_COMPARE=TRUE" + -D "TEST_REGEX= 0 error.s." + -D "TEST_MATCH= 0 error(s)" + -D "TEST_OUTPUT=vol_connector.txt" + #-D "TEST_REFERENCE=vol_connector.out" + -D "TEST_FOLDER=${PROJECT_BINARY_DIR}" + -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" + ) endif () #-- Adding test for fflush1 -add_test (NAME FORTRAN_fflush1 COMMAND $<TARGET_FILE:fflush1>) -set_tests_properties (FORTRAN_fflush1 PROPERTIES DEPENDS FORTRAN_testhdf5-clear-objects) +add_test ( + NAME FORTRAN_flush1-clear-objects + COMMAND ${CMAKE_COMMAND} -E remove flush.h5 +) +add_test ( + NAME FORTRAN_fflush1 + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:fflush1> +) +set_tests_properties (FORTRAN_fflush1 PROPERTIES + DEPENDS FORTRAN_flush1-clear-objects +) #-- Adding test for fflush2 -add_test (NAME FORTRAN_fflush2 COMMAND $<TARGET_FILE:fflush2>) -set_tests_properties (FORTRAN_fflush2 PROPERTIES DEPENDS FORTRAN_fflush1) - -if (BUILD_SHARED_LIBS AND NOT SKIP_HDF5_FORTRAN_SHARED) - add_test ( - NAME FORTRAN_testhdf5-shared-clear-objects - COMMAND ${CMAKE_COMMAND} - -E remove - a.h5 - b.h5 - c.h5 - d.h5 - dsetf_F03.h5 - enum1.h5 - extern_1a.raw - extern_2a.raw - extern_3a.raw - extern_4a.raw - extren_raw.raw - get_info.h5 - nbit.h5 - t_array_F03.h5 - t_bit_F03.h5 - t_controlchar_F03.h5 - t_enum_F03.h5 - t_objref_F03.h5 - t_opaque_F03.h5 - t_regref_F03.h5 - t_string_F03.h5 - t_vlen_F03.h5 - t_vlstring_F03.h5 - t_vlstringrw_F03.h5 - tarray1.h5 - tarray2.h5 - tarray3.h5 - test_create.h5 - tget_file_image.h5 - th5o_ref.h5 - titerate.h5 - vds.h5 - visit.h5 - WORKING_DIRECTORY - ${PROJECT_BINARY_DIR}/fshared - ) - set_tests_properties (FORTRAN_testhdf5-shared-clear-objects PROPERTIES DEPENDS FORTRAN_testhdf5-clear-objects) - - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_testhdf5_fortran-shared COMMAND $<TARGET_FILE:testhdf5_fortran-shared>) - else () - add_test (NAME FORTRAN_testhdf5_fortran-shared COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:testhdf5_fortran-shared>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_REGEX= 0 error.s." - -D "TEST_MATCH= 0 error(s)" - -D "TEST_OUTPUT=testhdf5_fortran.txt" - #-D "TEST_REFERENCE=testhdf5_fortran.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}/fshared" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () -# set_tests_properties (FORTRAN_testhdf5_fortran-shared PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") - set_tests_properties (FORTRAN_testhdf5_fortran-shared PROPERTIES DEPENDS "FORTRAN_testhdf5_fortran;FORTRAN_testhdf5-shared-clear-objects") - - #-- Adding test for testhdf5_fortran_1_8 - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_testhdf5_fortran_1_8-shared COMMAND $<TARGET_FILE:testhdf5_fortran_1_8-shared>) - else () - add_test (NAME FORTRAN_testhdf5_fortran_1_8-shared COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:testhdf5_fortran_1_8-shared>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_REGEX= 0 error.s." - -D "TEST_MATCH= 0 error(s)" - -D "TEST_OUTPUT=testhdf5_fortran_1_8.txt" - #-D "TEST_REFERENCE=testhdf5_fortran_1_8.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}/fshared" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () -# set_tests_properties (FORTRAN_testhdf5_fortran_1_8-shared PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") - set_tests_properties (FORTRAN_testhdf5_fortran_1_8-shared PROPERTIES DEPENDS FORTRAN_testhdf5_fortran_1_8) - - #-- Adding test for fortranlib_test_F03 - if (HDF5_ENABLE_F2003) - if (HDF5_ENABLE_USING_MEMCHECKER) - add_test (NAME FORTRAN_fortranlib_test_F03-shared COMMAND $<TARGET_FILE:fortranlib_test_F03-shared>) - else () - add_test (NAME FORTRAN_fortranlib_test_F03-shared COMMAND "${CMAKE_COMMAND}" - -D "TEST_PROGRAM=$<TARGET_FILE:fortranlib_test_F03-shared>" - -D "TEST_ARGS:STRING=" - -D "TEST_EXPECT=0" - -D "TEST_SKIP_COMPARE=TRUE" - -D "TEST_REGEX= 0 error.s." - -D "TEST_MATCH= 0 error(s)" - -D "TEST_OUTPUT=fortranlib_test_F03.txt" - #-D "TEST_REFERENCE=fortranlib_test_F03.out" - -D "TEST_FOLDER=${PROJECT_BINARY_DIR}/fshared" - -P "${HDF_RESOURCES_EXT_DIR}/runTest.cmake" - ) - endif () -# set_tests_properties (FORTRAN_fortranlib_test_F03-shared PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s") - set_tests_properties (FORTRAN_fortranlib_test_F03-shared PROPERTIES DEPENDS FORTRAN_fortranlib_test_F03) - endif () - - #-- Adding test for fflush1 - add_test (NAME FORTRAN_fflush1-shared COMMAND $<TARGET_FILE:fflush1-shared>) - set_tests_properties (FORTRAN_fflush1-shared PROPERTIES DEPENDS FORTRAN_fflush2) - - #-- Adding test for fflush2 - add_test (NAME FORTRAN_fflush2-shared COMMAND $<TARGET_FILE:fflush2-shared>) - set_tests_properties (FORTRAN_fflush2-shared PROPERTIES DEPENDS FORTRAN_fflush1-shared) -endif () +add_test ( + NAME FORTRAN_fflush2 + COMMAND ${CMAKE_CROSSCOMPILING_EMULATOR} $<TARGET_FILE:fflush2> +) +set_tests_properties (FORTRAN_fflush2 PROPERTIES + DEPENDS FORTRAN_fflush1 +) diff --git a/fortran/test/H5_test_buildiface.F90 b/fortran/test/H5_test_buildiface.F90 index 636ded4..6cbeb68 100644 --- a/fortran/test/H5_test_buildiface.F90 +++ b/fortran/test/H5_test_buildiface.F90 @@ -13,8 +13,8 @@ ! depending on which of the KIND values are found. ! ! NOTES -! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF -! depending on availablity.It generates code that makes use of +! This program uses the Fortran 2008 intrinsic function STORAGE_SIZE or SIZEOF +! depending on availablity.It generates code that makes use of ! STORAGE_SIZE/SIZEOF in H5fortran_detect.f90. STORAGE_SIZE is standard ! compliant and should always be chosen over SIZEOF. ! @@ -94,7 +94,7 @@ PROGRAM H5_test_buildiface WRITE(11,'(a)') "MODULE TH5_MISC_gen" WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' - + ! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs WRITE(11,'(A)') ' INTERFACE verify' @@ -156,8 +156,8 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)' WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_real_kind_'//TRIM(ADJUSTL(chr2)) WRITE(11,'(A)') '!DEC$endif' - -! Subroutine API + +! Subroutine API WRITE(11,'(A)') ' SUBROUTINE verify_real_kind_'//TRIM(ADJUSTL(chr2))//'(string,value,correct_value,total_error)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string' @@ -186,7 +186,7 @@ PROGRAM H5_test_buildiface ! { EXPONENT(x)-DIGITS(x) ! { 2.0 for x /= 0 ! SPACING(x) = { -! { +! { ! { TINY(x) for x == 0 ! ! The ULP optional argument scales the comparison: @@ -228,7 +228,7 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_character' WRITE(11,'(A)') '!DEC$endif' -! Subroutine API +! Subroutine API WRITE(11,'(A)') ' SUBROUTINE verify_character(string,value,correct_value,total_error)' WRITE(11,'(A)') ' IMPLICIT NONE' WRITE(11,'(A)') ' CHARACTER*(*) :: string' @@ -258,7 +258,7 @@ PROGRAM H5_test_buildiface WRITE(11,'(A)') ' total_error = total_error + 1' WRITE(11,'(A)') ' WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string' WRITE(11,'(A)') ' ENDIF' - + WRITE(11,'(A)') ' END SUBROUTINE verify_logical' WRITE(11,'(A)') "END MODULE TH5_MISC_gen" diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 8613cf9..0236e19 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -35,7 +35,7 @@ else endif # Our main targets, the tests themselves -TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F03 +TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8 fortranlib_test_F03 vol_connector check_PROGRAMS=$(TEST_PROG) @@ -50,6 +50,7 @@ fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_F03.F90 +vol_connector_SOURCES=vol_connector.F90 fflush1_SOURCES=fflush1.F90 fflush2_SOURCES=fflush2.F90 @@ -90,7 +91,7 @@ tf_gen.F90: H5_test_buildiface$(EXEEXT) H5_test_buildiface_SOURCES = H5_test_buildiface.F90 -# The build of the H5_test_buildiface does not depend on any libraries, so set it +# The build of the H5_test_buildiface does not depend on any libraries, so set it # to nothing. H5_test_buildiface_LDADD = diff --git a/fortran/test/fflush1.F90 b/fortran/test/fflush1.F90 index bd1f551..0916813 100644 --- a/fortran/test/fflush1.F90 +++ b/fortran/test/fflush1.F90 @@ -6,7 +6,7 @@ ! FUNCTION ! This is the first half of a two-part test that makes sure ! that a file can be read after an application crashes as long -! as the file was flushed first. We simulate by exit the +! as the file was flushed first. We simulate by exit the ! the program using stop statement ! ! COPYRIGHT diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index 8d5b32b..92f9279 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -81,7 +81,7 @@ PROGRAM fortranlibtest CALL file_space("file_space",cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' File free space test', total_error) -! +! ! '=========================================' ! 'Testing DATASET Interface ' ! '=========================================' @@ -97,7 +97,7 @@ PROGRAM fortranlibtest CALL test_userblock_offset(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Dataset offset with user block', total_error) -! +! ! '=========================================' ! 'Testing DATASPACE Interface ' ! '=========================================' @@ -106,7 +106,7 @@ PROGRAM fortranlibtest CALL dataspace_basic_test(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Basic dataspace test', total_error) -! +! ! '=========================================' ! 'Testing REFERENCE Interface ' ! '=========================================' @@ -119,7 +119,7 @@ PROGRAM fortranlibtest CALL refregtest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Reference to dataset region test', total_error) -! +! ! '=========================================' ! 'Testing selection functionalities ' ! '=========================================' @@ -148,8 +148,8 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL test_select_bounds(ret_total_error) CALL write_test_status(ret_total_error, ' Selection bounds test ', total_error) - -! + +! ! '=========================================' ! 'Testing DATATYPE interface ' ! '=========================================' @@ -169,7 +169,7 @@ PROGRAM fortranlibtest CALL test_derived_flt(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Derived float datatype test', total_error) -! +! ! '=========================================' ! 'Testing PROPERTY interface ' ! '=========================================' @@ -186,7 +186,7 @@ PROGRAM fortranlibtest CALL test_chunk_cache (cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Dataset chunk cache configuration', total_error) -! +! ! '=========================================' ! 'Testing ATTRIBUTE interface ' ! '=========================================' @@ -195,7 +195,7 @@ PROGRAM fortranlibtest CALL attribute_test(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Attribute test', total_error) -! +! ! '=========================================' ! 'Testing IDENTIFIER interface ' ! '=========================================' @@ -217,7 +217,7 @@ PROGRAM fortranlibtest CALL write_test_status(ret_total_error, ' SZIP filter test', total_error) ENDIF -! +! ! '=========================================' ! 'Testing GROUP interface ' ! '=========================================' diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 9a74120..377645d 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -24,7 +24,7 @@ !***** PROGRAM fortranlibtest_F03 - + USE HDF5 USE THDF5_F03 @@ -48,7 +48,7 @@ PROGRAM fortranlibtest_F03 IF(total_error .EQ. 0) THEN WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO") WRITE(*, '(I0)', advance="NO") majnum - WRITE(*, '(".")', advance="NO") + WRITE(*, '(".")', advance="NO") WRITE(*, '(I0)', advance="NO") minnum WRITE(*, '(" release ")', advance="NO") WRITE(*, '(I0)') relnum @@ -77,11 +77,11 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL t_enum(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing writing/reading enum dataset, using C_LOC', total_error) + CALL write_test_status(ret_total_error, ' Testing writing/reading enum dataset, using C_LOC', total_error) ret_total_error = 0 CALL t_enum_conv(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing enumeration conversions', total_error) + CALL write_test_status(ret_total_error, ' Testing enumeration conversions', total_error) ret_total_error = 0 CALL t_bit(ret_total_error) @@ -89,7 +89,7 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL t_opaque(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing writing/reading opaque datatypes, using C_LOC', total_error) + CALL write_test_status(ret_total_error, ' Testing writing/reading opaque datatypes, using C_LOC', total_error) ret_total_error = 0 CALL t_objref(ret_total_error) @@ -97,7 +97,7 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL t_regref(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing writing/reading region references, using C_LOC', total_error) + CALL write_test_status(ret_total_error, ' Testing writing/reading region references, using C_LOC', total_error) ret_total_error = 0 CALL t_vlen(ret_total_error) @@ -150,10 +150,10 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL test_h5p_file_image(ret_total_error) CALL write_test_status(ret_total_error, ' Testing h5pset/get file image', total_error) - + ! write(*,*) ! write(*,*) '=========================================' -! write(*,*) 'Testing GROUP interface ' +! write(*,*) 'Testing OBJECT interface ' ! write(*,*) '=========================================' ret_total_error = 0 @@ -161,11 +161,11 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Testing object functions ', total_error) ret_total_error = 0 - CALL obj_visit(ret_total_error) + CALL test_obj_visit(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object visiting functions ', total_error) ret_total_error = 0 - CALL obj_info(ret_total_error) + CALL test_obj_info(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) ret_total_error = 0 @@ -188,7 +188,7 @@ PROGRAM fortranlibtest_F03 WRITE(*, fmt = '(i4)', advance='NO') total_error WRITE(*, fmt = '(12a)' ) ' error(s) ! ' WRITE(*,*) ' ============================================ ' - + CALL h5close_f(error) ! if errors detected, exit with non-zero code. diff --git a/fortran/test/tH5A.F90 b/fortran/test/tH5A.F90 index 1e6fdeb..8968f59 100644 --- a/fortran/test/tH5A.F90 +++ b/fortran/test/tH5A.F90 @@ -21,7 +21,7 @@ ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! CONTAINS SUBROUTINES -! attribute_test +! attribute_test ! ! !***** diff --git a/fortran/test/tH5A_1_8.F90 b/fortran/test/tH5A_1_8.F90 index f2f11aa..8e59483 100644 --- a/fortran/test/tH5A_1_8.F90 +++ b/fortran/test/tH5A_1_8.F90 @@ -25,7 +25,7 @@ ! test_attr_create_by_name, test_attr_info_by_idx, attr_info_by_idx_check, ! test_attr_shared_rename, test_attr_delete_by_idx, test_attr_shared_delete, ! test_attr_dense_open, test_attr_dense_verify, test_attr_corder_create_basic, -! test_attr_basic_write, test_attr_many, attr_open_check, +! test_attr_basic_write, test_attr_many, attr_open_check, ! !***** MODULE TH5A_1_8 @@ -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) @@ -243,17 +243,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) @@ -279,7 +279,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 @@ -296,7 +296,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) @@ -304,15 +304,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) @@ -339,34 +339,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 verify("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 verify("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) @@ -374,7 +374,7 @@ 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) @@ -423,33 +423,33 @@ 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) @@ -457,7 +457,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) CALL verify("h5aread_f",value(1),103,total_error) ! Try to read data from the attribute again but -! for a scalar +! for a scalar value_scalar = 104 data_dims(1) = 1 @@ -479,7 +479,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) @@ -557,32 +557,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 @@ -596,7 +596,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) @@ -608,7 +608,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) @@ -626,39 +626,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) @@ -672,7 +672,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 @@ -682,12 +682,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) @@ -695,7 +695,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) @@ -704,16 +704,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) @@ -781,31 +781,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 @@ -816,7 +816,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) @@ -827,7 +827,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 @@ -840,7 +840,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 @@ -870,10 +870,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 @@ -881,19 +881,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 @@ -905,7 +905,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) @@ -913,17 +913,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) @@ -950,13 +950,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) @@ -964,7 +964,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 @@ -981,21 +981,21 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) ! 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) @@ -1113,114 +1113,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 @@ -1229,19 +1229,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 @@ -1249,12 +1249,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 @@ -1263,103 +1263,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) @@ -1384,9 +1384,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" @@ -1424,40 +1424,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 @@ -1471,7 +1471,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) @@ -1482,7 +1482,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) @@ -1497,36 +1497,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) @@ -1545,11 +1545,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) @@ -1557,7 +1557,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, & @@ -1572,7 +1572,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), & @@ -1589,7 +1589,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) @@ -1597,7 +1597,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) @@ -1611,11 +1611,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 @@ -1623,24 +1623,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) @@ -1652,15 +1652,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) @@ -1672,7 +1672,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 @@ -1691,17 +1691,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) @@ -1709,18 +1709,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) @@ -1775,77 +1775,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) @@ -1853,42 +1853,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 @@ -1897,31 +1897,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 @@ -1930,21 +1930,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) @@ -1952,31 +1952,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) @@ -1984,13 +1984,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) @@ -2040,73 +2040,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 @@ -2114,36 +2114,36 @@ 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") @@ -2179,21 +2179,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 @@ -2202,22 +2202,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 @@ -2228,14 +2228,14 @@ 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 @@ -2270,30 +2270,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) @@ -2302,60 +2302,60 @@ 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) @@ -2418,97 +2418,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 @@ -2539,7 +2539,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check('H5Aget_name_f',error,total_error) CALL verify('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) @@ -2547,11 +2547,11 @@ 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) @@ -2594,20 +2594,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 @@ -2651,15 +2651,15 @@ 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) @@ -2677,7 +2677,7 @@ END SUBROUTINE test_attr_many ! * March 21, 2008 ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) @@ -2699,10 +2699,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 @@ -2712,12 +2712,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 verify("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error) CALL verify("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error) @@ -2727,18 +2727,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 verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error) CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error) @@ -2746,21 +2746,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 verify("h5aget_info_f",f_corder_valid,.TRUE.,total_error) CALL verify("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error) @@ -2768,7 +2768,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/tH5D.F90 b/fortran/test/tH5D.F90 index 7001b98..7f8a988 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -44,31 +44,31 @@ CONTAINS IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error - + CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name CHARACTER(LEN=9), PARAMETER :: null_dsetname = "null_dset" ! Dataset name - + INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: null_dset ! Null dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: null_dspace ! Null dataspace identifier INTEGER(HID_T) :: dtype_id ! Datatype identifier - + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions INTEGER :: rank = 2 ! Dataset rank - + INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers INTEGER :: error ! Error flag - + INTEGER :: i, j !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HSIZE_T), DIMENSION(1) :: null_data_dim INTEGER :: null_dset_data = 1 ! null data INTEGER :: flag ! Space allocation status - + ! ! Initialize the dset_data array. ! @@ -157,10 +157,10 @@ CONTAINS CALL h5dget_space_status_f(dset_id, flag, error) CALL check("h5dget_space_status_f",error, total_error) CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_ALLOCATED_F, total_error) - + CALL h5dget_space_status_f(null_dset, flag, error) CALL check("h5dget_space_status_f",error, total_error) - CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_NOT_ALLOCATED_F, total_error) + CALL VERIFY("h5dget_space_status_f", flag, H5D_SPACE_STS_NOT_ALLOCATED_F, total_error) ! ! Get the dataset type. ! @@ -210,7 +210,7 @@ CONTAINS ! CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f", error, total_error) - + ! ! Terminate access to the data type. ! @@ -223,86 +223,86 @@ CONTAINS CALL check("h5fclose_f", error, total_error) IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE datasettest - + ! !the following subroutine tests h5dextend_f functionality ! SUBROUTINE extenddsettest(cleanup, total_error) - + IMPLICIT NONE - + LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error - + ! !the dataset is stored in file "extf.h5" ! CHARACTER(LEN=4), PARAMETER :: filename = "extf" CHARACTER(LEN=80) :: fix_filename - + ! !dataset name is "ExtendibleArray" ! CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray" - + ! !dataset rank is 2 ! INTEGER :: RANK = 2 - + INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dataspace ! Dataspace identifier INTEGER(HID_T) :: memspace ! memory Dataspace identifier INTEGER(HID_T) :: crp_list ! dataset creatation property identifier - + ! !dataset dimensions at creation time ! INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/) - + ! !data dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/) - + ! !Maximum dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: maxdims - + ! !data arrays for reading and writing ! INTEGER, DIMENSION(10,3) :: data_in, data_out - + ! !Size of data in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: size - + ! !general purpose integer ! INTEGER :: i, j INTEGER(HSIZE_T) :: ih, jh - + ! !flag to check operation success ! INTEGER :: error - + ! !Variables used in reading data back ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr INTEGER :: rankr INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - + ! !data initialization ! @@ -311,7 +311,7 @@ CONTAINS data_in(i,j) = 2 END DO END DO - + ! !Initialize FORTRAN predifined datatypes ! @@ -328,24 +328,24 @@ CONTAINS ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - + ! !Create the data space with unlimited dimensions. ! maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/) - + CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims) CALL check("h5screate_simple_f",error,total_error) - + ! !Modify dataset creation properties, i.e. enable chunking ! CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) CALL check("h5pcreate_f",error,total_error) - + CALL h5pset_chunk_f(crp_list, RANK, dims1, error) CALL check("h5pset_chunk_f",error,total_error) - + ! !Create a dataset with 3X3 dimensions using cparms creation propertie . ! @@ -359,8 +359,8 @@ CONTAINS SIZE(2) = 3 CALL h5dextend_f(dset_id, size, error) CALL check("h5dextend_f",error,total_error) - - + + ! !Extend the dataset. Dataset becomes 10 x 3. ! @@ -368,7 +368,7 @@ CONTAINS SIZE(2) = 3; CALL h5dextend_f(dset_id, size, error) CALL check("h5dextend_f",error,total_error) - + ! !Write the data of size 10X3 to the extended dataset. ! @@ -376,13 +376,13 @@ CONTAINS data_dims(2) = 3 CALL H5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) CALL check("h5dwrite_f",error,total_error) - + ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f",error,total_error) - + ! !Close the property list. ! @@ -393,13 +393,13 @@ CONTAINS ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) - + ! !Close the file. ! CALL h5fclose_f(file_id, error) CALL check("h5fclose_f",error,total_error) - + ! !read the data back ! @@ -407,19 +407,19 @@ CONTAINS ! CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) CALL check("hfopen_f",error,total_error) - + ! !Open the dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f",error,total_error) - + ! !Get dataset's dataspace handle. ! CALL h5dget_space_f(dset_id, dataspace, error) CALL check("h5dget_space_f",error,total_error) - + ! !Get dataspace's rank. ! @@ -429,7 +429,7 @@ CONTAINS WRITE(*,*) "dataset rank error occured" STOP END IF - + ! !Get dataspace's dimensinons. ! @@ -439,27 +439,27 @@ CONTAINS WRITE(*,*) "dataset dimensions error occured" STOP END IF - + ! !Get creation property list. ! CALL h5dget_create_plist_f(dset_id, crp_list, error) CALL check("h5dget_create_plist_f",error,total_error) - + ! !create memory dataspace. ! CALL h5screate_simple_f(rankr, dimsr, memspace, error) CALL check("h5screate_simple_f",error,total_error) - + ! !Read data ! CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, memspace, dataspace) CALL check("h5dread_f",error,total_error) - + ! !Compare the data. ! @@ -471,31 +471,31 @@ CONTAINS END IF END DO END DO - + ! !Close the dataspace for the dataset. ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f",error,total_error) - + ! !Close the memspace for the dataset. ! CALL h5sclose_f(memspace, error) CALL check("h5sclose_f",error,total_error) - + ! !Close the property list. ! CALL h5pclose_f(crp_list, error) CALL check("h5pclose_f",error,total_error) - + ! !Close the dataset. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) - + ! !Close the file. ! @@ -503,7 +503,7 @@ CONTAINS CALL check("h5fclose_f",error,total_error) IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE extenddsettest @@ -549,7 +549,7 @@ CONTAINS DO i = 1, dset_dim1 DO j = 1, dset_dim2 n = n + 1 - data_in(i,j) = n + data_in(i,j) = n END DO END DO CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file, error, fcpl) @@ -557,7 +557,7 @@ CONTAINS ! Create the data space dims(1:2) = (/dset_dim1,dset_dim2/) - + CALL h5screate_simple_f(2, dims, space, error) CALL check("h5screate_simple_f",error,total_error) @@ -596,7 +596,7 @@ CONTAINS total_error = total_error + 1 RETURN ENDIF - ! The pos= specifier illustrates that positions are in bytes, + ! The pos= specifier illustrates that positions are in bytes, ! starting from byte 1 (as opposed to C, where they start from byte 0) READ(10, POS=offset+1, IOSTAT=ios) rdata IF(ios.NE.0)THEN @@ -625,7 +625,7 @@ CONTAINS CALL check("h5_cleanup_f", error, total_error) IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + END SUBROUTINE test_userblock_offset END MODULE TH5D diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 1878966..a8ca103 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5E APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -168,10 +168,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 d91ee9c..16464dd 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -25,12 +25,10 @@ ! !***** ! -! In the mountingtest subroutine we create one file with a group in it, +! In the mountingtest subroutine we create one file with a group in it, ! and another file with a dataset. Mounting is used to -! access the dataset from the second file as a member of a group -! in the first file. - - +! access the dataset from the second file as a member of a group +! in the first file. MODULE TH5F @@ -103,6 +101,14 @@ CONTAINS ! INTEGER :: i, j + !number of objects + INTEGER(SIZE_T) :: obj_count + INTEGER(HID_T) :: t1, t2, t3, t4 + + ! File numbers + INTEGER :: file_num1 + INTEGER :: file_num2 + ! !data buffers ! @@ -133,11 +139,51 @@ CONTAINS CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) if(error .ne. 0) stop + ! Test object counts + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t1, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t2, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t3, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t4, error) + CALL check(" h5tcopy_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.4)THEN + total_error = total_error + 1 + ENDIF + ! !Create first file "mount1.h5" using default properties. ! CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.5)THEN + total_error = total_error + 1 + ENDIF + + CALL h5tclose_f(t1, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t2, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t3, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t4, error) + CALL check("h5tclose_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF ! !Create group "/G" inside file "mount1.h5". @@ -190,7 +236,24 @@ CONTAINS CALL check("h5fclose_f",error,total_error) ! - !test whether files are in hdf5 format + !test whether files are accessible as HDF5 (new, VOL-safe, way) + ! + CALL h5fis_accessible_f(fix_filename1, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not accessible as hdf5" + stop + END IF + + CALL h5fis_accessible_f(fix_filename2, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not accessible as hdf5" + stop + END IF + + ! + !test whether files are in hdf5 format (old way) ! CALL h5fis_hdf5_f(fix_filename1, status, error) CALL check("h5fis_hdf5_f",error,total_error) @@ -211,9 +274,35 @@ CONTAINS ! CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) CALL check("hfopen_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF + CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) CALL check("h5fopen_f",error,total_error) + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + + ! + !Check file numbers + ! + CALL h5fget_fileno_f(file1_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(file2_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .EQ. file_num2) THEN + write(*,*) "file numbers aren't supposed to match" + END IF + ! !mount the second file under the first file's "/G" group. ! @@ -245,6 +334,7 @@ CONTAINS do i = 1, NX do j = 1, NY IF (data_out(i,j) .NE. data_in(i, j)) THEN + total_error = total_error + 1 END IF end do end do @@ -267,11 +357,26 @@ CONTAINS ! !Close both files. ! + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + CALL h5fclose_f(file1_id, error) CALL check("h5fclose_f",error,total_error) CALL h5fclose_f(file2_id, error) CALL check("h5fclose_f",error,total_error) + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.0)THEN + total_error = total_error + 1 + ENDIF + if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) @@ -342,6 +447,8 @@ CONTAINS INTEGER, DIMENSION(4,6) :: dset_data, data_out INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HSIZE_T) :: file_size + INTEGER :: file_num1 + INTEGER :: file_num2 CHARACTER(LEN=80) :: file_name INTEGER(SIZE_T) :: name_size @@ -410,6 +517,17 @@ CONTAINS CALL check("h5fget_filesize_f",error,total_error) ! + !Check file numbers + ! + CALL h5fget_fileno_f(file_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(reopen_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .NE. file_num2) THEN + write(*,*) "file numbers don't match" + END IF + + ! !Open the dataset based on the reopen_id. ! CALL h5dopen_f(reopen_id, dsetname, dset_id, error) @@ -769,5 +887,4 @@ CONTAINS END SUBROUTINE file_space - END MODULE TH5F diff --git a/fortran/test/tH5F_F03.F90 b/fortran/test/tH5F_F03.F90 index 8cc6b83..f938565 100644 --- a/fortran/test/tH5F_F03.F90 +++ b/fortran/test/tH5F_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5F APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -37,8 +37,8 @@ MODULE TH5F_F03 USE HDF5 - USE TH5_MISC - USE TH5_MISC_GEN + USE TH5_MISC + USE TH5_MISC_GEN USE ISO_C_BINDING CONTAINS @@ -79,21 +79,21 @@ SUBROUTINE test_get_file_image(total_error) CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f", error, total_error) - ! Set up data space for new data set + ! Set up data space for new data set dims(1:2) = (/10,10/) - + CALL h5screate_simple_f(2, dims, space_id, error) CALL check("h5screate_simple_f", error, total_error) - ! Create a dataset + ! Create a dataset CALL h5dcreate_f(file_id, "dset 0", H5T_NATIVE_INTEGER, space_id, dset_id, error) CALL check("h5dcreate_f", error, total_error) - ! Write some data to the data set + ! Write some data to the data set DO i = 1, 100 data(i) = INT(i) ENDDO - + f_ptr = C_LOC(data(1)) CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error) CALL check("h5dwrite_f",error, total_error) @@ -102,7 +102,7 @@ SUBROUTINE test_get_file_image(total_error) CALL h5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) CALL check("h5fflush_f",error, total_error) - ! Open the test file using standard I/O calls + ! Open the test file using standard I/O calls OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') ! Get the size of the test file ! @@ -110,8 +110,8 @@ SUBROUTINE test_get_file_image(total_error) ! may be larger. This is OK, as long as (in this specialized instance) ! the remainder of the file is all '\0's. ! - ! With latest mods to truncate call in core file drive, - ! file size should match image size; get the file size + ! With latest mods to truncate call in core file drive, + ! file size should match image size; get the file size INQUIRE(UNIT=10, SIZE=file_sz) CLOSE(UNIT=10) @@ -131,7 +131,7 @@ SUBROUTINE test_get_file_image(total_error) CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - ! Allocate a buffer of the appropriate size + ! Allocate a buffer of the appropriate size ALLOCATE(image_ptr(1:image_size)) ! Load the image of the file into the buffer @@ -139,7 +139,7 @@ SUBROUTINE test_get_file_image(total_error) CALL h5fget_file_image_f(file_id, f_ptr, image_size, error) CALL check("h5fget_file_image_f",error, total_error) - ! Close dset and space + ! Close dset and space CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) CALL h5sclose_f(space_id, error) @@ -151,7 +151,7 @@ SUBROUTINE test_get_file_image(total_error) ! Allocate a buffer for the test file image ALLOCATE(file_image_ptr(1:image_size)) - ! Open the test file using standard I/O calls + ! Open the test file using standard I/O calls OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') ! Read the test file from disk into the buffer diff --git a/fortran/test/tH5G_1_8.F90 b/fortran/test/tH5G_1_8.F90 index d3be525..c35edad 100644 --- a/fortran/test/tH5G_1_8.F90 +++ b/fortran/test/tH5G_1_8.F90 @@ -22,7 +22,7 @@ ! ! CONTAINS SUBROUTINES ! group_test, group_info, timestamps, mklinks, test_move_preserves, lifecycle -! cklinks, delete_by_idx, link_info_by_idx_check, test_lcpl, objcopy, +! cklinks, delete_by_idx, link_info_by_idx_check, test_lcpl, objcopy, ! lapl_nlinks ! !***** @@ -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 @@ -135,7 +135,7 @@ END SUBROUTINE group_test ! * February 18, 2008 ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE group_info(cleanup, fapl, total_error) @@ -143,21 +143,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 @@ -165,34 +165,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 @@ -241,11 +241,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 @@ -254,103 +254,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 verify("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 verify("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), & @@ -363,72 +363,72 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("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) @@ -449,7 +449,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * February 20, 2008 ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE timestamps(cleanup, fapl, total_error) @@ -457,15 +457,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 @@ -473,58 +473,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 verify("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 verify("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 verify("H5Pget_obj_track_times1",track_times,.FALSE.,total_error) @@ -532,11 +532,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL verify("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 @@ -550,40 +550,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) @@ -592,11 +592,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL verify("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 @@ -610,19 +610,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) @@ -643,7 +643,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE mklinks(fapl, total_error) @@ -665,40 +665,40 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR _F - Error - INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + TYPE(H5O_TOKEN_T_F) :: token ! If the link is a hard link, token specifies the object token that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value -! WRITE(*,*) "link creation (w/new group format)" + 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) CALL H5Lget_info_f(file, "grp1/soft", & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & error, H5P_DEFAULT_F) CALL check("H5Lget_info_f",error,total_error) @@ -709,14 +709,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) @@ -736,7 +736,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE test_move_preserves(fapl_id, total_error) @@ -746,20 +746,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. @@ -770,7 +770,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR _F - Error - INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + TYPE(H5O_TOKEN_T_F) :: token ! If the link is a hard link, token specifies the object token that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value INTEGER :: error @@ -779,7 +779,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! 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) @@ -795,28 +795,28 @@ 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, & + cset, corder, f_corder_valid, link_type, token, val_size, & error, H5P_DEFAULT_F) CALL check("H5Lget_info_f",error,total_error) @@ -830,18 +830,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 @@ -849,7 +849,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 @@ -862,7 +862,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ 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 @@ -870,10 +870,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 @@ -881,10 +881,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 @@ -894,7 +894,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !!$ !!$ 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 @@ -902,10 +902,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 @@ -913,10 +913,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) @@ -941,7 +941,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! * Monday, October 17, 2005 ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE lifecycle(cleanup, fapl2, total_error) IMPLICIT NONE @@ -951,14 +951,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 @@ -975,29 +975,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) @@ -1014,7 +1014,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) @@ -1023,12 +1023,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) @@ -1046,20 +1046,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) ! * Modifications: Modified original C code ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE cklinks(fapl, total_error) @@ -1104,25 +1104,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) @@ -1131,7 +1131,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Lexists_f(file,"grp1/hard",Lexists, error) CALL verify("H5Lexists", Lexists,.TRUE.,total_error) - ! Cleanup + ! Cleanup CALL H5Fclose_f(file,error) CALL check("H5Fclose_f",error,total_error) @@ -1153,25 +1153,25 @@ END SUBROUTINE cklinks ! * March 3, 2008 ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE delete_by_idx(cleanup, fapl, total_error) IMPLICIT NONE 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 @@ -1179,13 +1179,13 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(SIZE_T) :: val_size INTEGER :: link_type - INTEGER(HADDR_T) :: address + TYPE(H5O_TOKEN_T_F) :: token - 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 @@ -1203,13 +1203,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 @@ -1240,15 +1240,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 @@ -1258,61 +1258,61 @@ 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), & - link_type, f_corder_valid, corder, cset, address, val_size, error) + link_type, f_corder_valid, corder, cset, token, val_size, error) - CALL H5Oopen_by_addr_f(group_id, address, grp, error) - CALL check("H5Oopen_by_addr_f", error, total_error) + CALL H5Oopen_by_token_f(group_id, token, grp, error) + CALL check("H5Oopen_by_token_f", error, total_error) CALL H5Iget_type_f(grp, id_type, error) CALL check("H5Iget_type_f", error, total_error) @@ -1335,7 +1335,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) @@ -1351,17 +1351,17 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) !!$ CALL verify("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) + CALL check("delete_by_idx.H5Pclose_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) + CALL check("delete_by_idx.H5Fclose_f", error, total_error) IF(cleanup) CALL h5_cleanup_f("file0", H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) @@ -1391,7 +1391,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) @@ -1407,38 +1407,38 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER :: link_type - INTEGER(HADDR_T) :: address + TYPE(H5O_TOKEN_T_F) :: token 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) + link_type, f_corder_valid, corder, cset, token, 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) + link_type, f_corder_valid, corder, cset, token, 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); !!$ @@ -1448,7 +1448,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 @@ -1492,7 +1492,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE test_lcpl(cleanup, fapl, total_error) @@ -1516,7 +1516,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! H5L_TYPE_SOFT_F - Soft link ! H5L_TYPE_EXTERNAL_F - External link ! H5L_TYPE_ERROR _F - Error - INTEGER(HADDR_T) :: address ! If the link is a hard link, address specifies the file address that the link points to + TYPE(H5O_TOKEN_T_F) :: token ! If the link is a hard link, token specifies the object token that the link points to INTEGER(SIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value CHARACTER(LEN=1024) :: filename = 'tempfile.h5' @@ -1537,34 +1537,34 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! Actually, intermediate group creation is tested elsewhere (tmisc). - ! * Here we only need to test the character encoding property + ! * 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, & + cset, corder, f_corder_valid, link_type, token, 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. +! * 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) @@ -1573,19 +1573,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, & + cset, corder, f_corder_valid, link_type, token, 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. +! * 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) @@ -1595,7 +1595,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) @@ -1607,10 +1607,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. ! @@ -1629,45 +1629,45 @@ 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, & + cset, corder, f_corder_valid, link_type, token, 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. +! * 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, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) @@ -1677,14 +1677,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, & + cset, corder, f_corder_valid, link_type, token, 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) @@ -1695,14 +1695,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, & + cset, corder, f_corder_valid, link_type, token, 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) @@ -1717,24 +1717,24 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("H5Lexists",error, total_error) CALL verify("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, & + cset, corder, f_corder_valid, link_type, token, 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, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) @@ -1742,13 +1742,13 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("H5Lcreate_soft_f", error, total_error) CALL H5Lget_info_f(file_id, "slink_to_dset2", & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) @@ -1756,13 +1756,13 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("H5Lmove_f",error, total_error) CALL H5Lget_info_f(file_id, "moved_slink", & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) @@ -1770,25 +1770,25 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL H5Lcopy_f(file_id, "moved_slink", file_id, "copied_slink", error, lcpl_id) CALL H5Lget_info_f(file_id, "copied_slink", & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) CALL H5Lget_info_f(file_id, "extlink", & - cset, corder, f_corder_valid, link_type, address, val_size, & + cset, corder, f_corder_valid, link_type, token, val_size, & error) CALL check("H5Lget_info_f", error, total_error) 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) @@ -1817,22 +1817,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) @@ -1862,7 +1862,7 @@ END SUBROUTINE objcopy ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE lapl_nlinks( fapl, total_error) @@ -1872,30 +1872,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) @@ -1914,26 +1914,26 @@ 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) @@ -1941,71 +1941,71 @@ SUBROUTINE lapl_nlinks( fapl, total_error) ! Open object through what is normally too many soft links using - ! * new property list + ! * 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 verify("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 verify("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 ! * 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) @@ -2013,27 +2013,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) @@ -2048,12 +2048,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.") @@ -2063,7 +2063,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) @@ -2083,7 +2083,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) ! 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) @@ -2093,7 +2093,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) @@ -2102,7 +2102,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) @@ -2111,11 +2111,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/tH5I.F90 b/fortran/test/tH5I.F90 index 5ce37fd..1934acf 100644 --- a/fortran/test/tH5I.F90 +++ b/fortran/test/tH5I.F90 @@ -25,8 +25,8 @@ ! !***** MODULE TH5I - - USE HDF5 ! This module contains all necessary modules + + USE HDF5 ! This module contains all necessary modules USE TH5_MISC USE TH5_MISC_GEN @@ -87,21 +87,21 @@ CONTAINS ! check that the ID is not valid dtype = -1 CALL H5Iis_valid_f(dtype, tri_ret, error) - CALL check("H5Iis_valid_f", error, total_error) + CALL check("H5Iis_valid_f", error, total_error) CALL verify("H5Iis_valid_f", tri_ret, .FALSE., total_error) - + ! Create a datatype id CALL H5Tcopy_f(H5T_NATIVE_INTEGER,dtype,error) - CALL check("H5Tcopy_f", error, total_error) - + CALL check("H5Tcopy_f", error, total_error) + ! Check that the ID is valid CALL H5Iis_valid_f(dtype, tri_ret, error) - CALL check("H5Iis_valid_f", error, total_error) + CALL check("H5Iis_valid_f", error, total_error) CALL verify("H5Tequal_f", tri_ret, .TRUE., total_error) - + CALL H5Tclose_f(dtype, error) - CALL check("H5Tclose_f", error, total_error) - + CALL check("H5Tclose_f", error, total_error) + ! ! Create a new file using default properties. ! diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index bdb5c55..a8a8c65 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5L APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -30,8 +30,8 @@ !***** MODULE liter_cb_mod - USE HDF5 - USE TH5_MISC + USE HDF5 + USE TH5_MISC USE TH5_MISC_GEN USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -43,11 +43,11 @@ MODULE liter_cb_mod INTEGER RET_CHANGE2 END TYPE iter_enum - ! Custom group iteration callback data + ! Custom group iteration callback data TYPE, bind(c) :: iter_info - CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object - INTEGER(c_int) :: TYPE ! The TYPE of the object - INTEGER(c_int) :: command ! The TYPE of RETURN value + CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value END TYPE iter_info CONTAINS @@ -73,7 +73,7 @@ CONTAINS INTEGER, SAVE :: count INTEGER, SAVE :: count2 -!!$ +!!$ !!$ iter_info *info = (iter_info *)op_data; !!$ static int count = 0; !!$ static int count2 = 0; @@ -126,17 +126,17 @@ SUBROUTINE test_iter_group(total_error) INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: fapl - INTEGER(HID_T) :: file ! File ID - INTEGER(hid_t) :: dataset ! Dataset ID - INTEGER(hid_t) :: datatype ! Common datatype ID - INTEGER(hid_t) :: filespace ! Common dataspace ID - INTEGER(hid_t) :: grp ! Group ID - INTEGER i,j ! counting variable - INTEGER(hsize_t) idx ! Index in the group + INTEGER(HID_T) :: file ! File ID + INTEGER(hid_t) :: dataset ! Dataset ID + INTEGER(hid_t) :: datatype ! Common datatype ID + INTEGER(hid_t) :: filespace ! Common dataspace ID + INTEGER(hid_t) :: grp ! Group ID + INTEGER i,j ! counting variable + INTEGER(hsize_t) idx ! Index in the group CHARACTER(LEN=11) :: DATAFILE = "titerate.h5" INTEGER, PARAMETER :: ndatasets = 50 - CHARACTER(LEN=10) :: name ! temporary name buffer - CHARACTER(LEN=10), DIMENSION(1:ndatasets+2) :: lnames ! Names of the links created + CHARACTER(LEN=10) :: name ! temporary name buffer + CHARACTER(LEN=10), DIMENSION(1:ndatasets+2) :: lnames ! Names of the links created TYPE(iter_info), TARGET :: info @@ -147,15 +147,15 @@ SUBROUTINE test_iter_group(total_error) CHARACTER(LEN=2) :: ichr2 CHARACTER(LEN=10) :: ichr10 - ! Get the default FAPL + ! Get the default FAPL CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) CALL check("h5pcreate_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(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) - ! Create the test file with the datasets + ! Create the test file with the datasets CALL h5fcreate_f(DATAFILE, H5F_ACC_TRUNC_F, file, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f", error, total_error) @@ -190,12 +190,12 @@ SUBROUTINE test_iter_group(total_error) ENDDO - ! Create a group and named datatype under root group for testing + ! Create a group and named datatype under root group for testing CALL H5Gcreate_f(file, "grp0000000", grp, error) CALL check("H5Gcreate_f", error, total_error) - lnames(ndatasets+2) = "grp0000000" + lnames(ndatasets+2) = "grp0000000" !!$ !!$ lnames[NDATASETS] = HDstrdup("grp"); @@ -205,9 +205,9 @@ SUBROUTINE test_iter_group(total_error) CALL H5Tcommit_f(file, "dtype00000", datatype, error) CALL check("H5Tcommit_f", error, total_error) - lnames(ndatasets+1) = "dtype00000" + lnames(ndatasets+1) = "dtype00000" - ! Close everything up + ! Close everything up CALL H5Tclose_f(datatype, error) CALL check("H5Tclose_f", error, total_error) @@ -221,11 +221,11 @@ SUBROUTINE test_iter_group(total_error) CALL H5Fclose_f(file, error) CALL check("H5Fclose_f", error, total_error) - ! Iterate through the datasets in the root group in various ways + ! Iterate through the datasets in the root group in various ways CALL H5Fopen_f(DATAFILE, H5F_ACC_RDONLY_F, file, error, access_prp=fapl) CALL check("h5fopen_f", error, total_error) - ! Test all objects in group, when callback always returns 0 + ! Test all objects in group, when callback always returns 0 info%command = 0 idx = 0 CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) @@ -234,28 +234,28 @@ SUBROUTINE test_iter_group(total_error) CALL verify("H5Literate_f", error, -1, total_error) ENDIF - ! Test all objects in group, when callback always returns 1 - ! This also tests the "restarting" ability, because the index changes + ! Test all objects in group, when callback always returns 1 + ! This also tests the "restarting" ability, because the index changes info%command = 2 idx = 0 i = 0 f1 = C_FUNLOC(liter_cb) f2 = C_LOC(info) - DO + DO CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) IF(error.LT.0) EXIT - ! Verify return value from iterator gets propagated correctly + ! Verify return value from iterator gets propagated correctly CALL verify("H5Literate", ret_value, 2, total_error) - ! Increment the number of times "2" is returned + ! Increment the number of times "2" is returned i = i + 1 - ! Verify that the index is the correct value + ! Verify that the index is the correct value CALL verify("H5Literate", INT(idx), INT(i), total_error) IF(idx .GT.ndatasets+2)THEN PRINT*,"ERROR: Group iteration function walked too far!" ENDIF - ! Verify the correct name is retrieved + ! Verify the correct name is retrieved DO j = 1, 10 ichr10(j:j) = info%name(j)(1:1) ENDDO @@ -270,8 +270,8 @@ SUBROUTINE test_iter_group(total_error) PRINT*,"ERROR: Group iteration function didn't perform multiple iterations correctly" ENDIF - ! Test all objects in group, when callback changes return value - ! This also tests the "restarting" ability, because the index changes + ! Test all objects in group, when callback changes return value + ! This also tests the "restarting" ability, because the index changes info%command = 3 idx = 0 @@ -285,10 +285,10 @@ SUBROUTINE test_iter_group(total_error) IF(error.LT.0) EXIT CALL verify("H5Literate_f", ret_value, 1, total_error) - ! Increment the number of times "1" is returned + ! Increment the number of times "1" is returned i = i + 1 - ! Verify that the index is the correct value + ! Verify that the index is the correct value CALL verify("H5Literate_f", INT(idx), INT(i+10), total_error) IF(idx .GT.ndatasets+2)THEN @@ -298,7 +298,7 @@ SUBROUTINE test_iter_group(total_error) DO j = 1, 10 ichr10(j:j) = info%name(j)(1:1) ENDDO - ! Verify that the correct name is retrieved + ! Verify that the correct name is retrieved CALL verify("H5Literate_f", ichr10, lnames(INT(idx)), total_error) IF(i.EQ.42)EXIT ! prints out error message otherwise (for gcc/gfortran/g95) not intel (why) -FIX- scot ENDDO diff --git a/fortran/test/tH5MISC_1_8.F90 b/fortran/test/tH5MISC_1_8.F90 index 79fbf3e..bad77d0 100644 --- a/fortran/test/tH5MISC_1_8.F90 +++ b/fortran/test/tH5MISC_1_8.F90 @@ -95,18 +95,18 @@ SUBROUTINE test_genprop_basic_class(total_error) IMPLICIT NONE 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=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" @@ -116,11 +116,11 @@ SUBROUTINE test_genprop_basic_class(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) @@ -150,27 +150,27 @@ SUBROUTINE test_genprop_basic_class(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 verify("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 verify("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) @@ -187,16 +187,17 @@ SUBROUTINE test_h5s_encode(total_error) IMPLICIT NONE 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(size_t) :: sbuf_size=0, scalar_size=0 + INTEGER(hid_t) :: fapl ! File access property + INTEGER :: rank ! LOGICAL rank of dataspace + INTEGER(size_t) :: new_size = 0, old_size = 0, orig_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/) @@ -216,7 +217,7 @@ SUBROUTINE test_h5s_encode(total_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) @@ -226,27 +227,45 @@ SUBROUTINE test_h5s_encode(total_error) CALL check("h5sselect_hyperslab_f", error, total_error) - ! Encode simple data space in a buffer + ! Encode simple data space in a buffer + + ! Find the buffer size without fapl + CALL H5Sencode_f(sid1, sbuf, orig_size, error) + CALL check("H5Sencode_f", error, total_error) + CALL verify("H5Sencode_f", INT(orig_size), 279, total_error) - ! First find the buffer size - CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) - CALL check("H5Sencode", error, total_error) + ! Create file access property list + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + ! Find the buffer size with fapl (default old format) + CALL H5Sencode_f(sid1, sbuf, old_size, error, fapl) + CALL check("H5Sencode_f", error, total_error) + CALL verify("H5Sencode_f", INT(old_size), 279, total_error) - ! Try decoding bogus buffer + ! Set fapl to latest file format + CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + ! Find the buffer size with fapl set to latest format + CALL H5Sencode_f(sid1, sbuf, new_size, error, fapl) + CALL check("H5Sencode_f", error, total_error) + CALL verify("H5Sencode_f", INT(new_size), 101, total_error) + + ! Try decoding bogus buffer CALL H5Sdecode_f(sbuf, decoded_sid1, error) CALL verify("H5Sdecode", error, -1, total_error) - CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) - CALL check("H5Sencode", error, total_error) + ! Encode according to the latest file format + CALL H5Sencode_f(sid1, sbuf, new_size, error, fapl) + 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(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), & @@ -264,13 +283,13 @@ SUBROUTINE test_h5s_encode(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) @@ -282,19 +301,19 @@ SUBROUTINE test_h5s_encode(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) @@ -340,7 +359,7 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/) INTEGER, DIMENSION(1:2,1:5) :: orig_data INTEGER, DIMENSION(1:2,1:5) :: new_data - INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab + INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes @@ -371,11 +390,11 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) CALL H5Screate_simple_f(2, dims, space, error) CALL CHECK(" H5Screate_simple_f", error, total_error) - ! Create the dataset property list + ! Create the dataset property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) CALL CHECK(" H5Pcreate_f", error, total_error) - ! Set fill value + ! Set fill value fillval = 10000 CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error) CALL CHECK(" H5Pset_fill_value_f", error, total_error) @@ -383,10 +402,10 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) ! Set up to use scaleoffset filter, let library calculate minbits CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) CALL CHECK(" H5Pset_chunk_f", error, total_error) - + CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error) CALL CHECK(" H5Pset_scaleoffset_f", error, total_error) - + ! Create the dataset CALL H5Dcreate_f(file, "scaleoffset_int", datatype, & space, dataset, error, dc) @@ -398,7 +417,7 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) ! Select hyperslab for data to write, using 1x5 blocks, ! (1,1) stride and (1,1) count starting at the position (0,0) - + start(1:2) = (/0,0/) stride(1:2) = (/1,1/) COUNT(1:2) = (/1,1/) @@ -422,21 +441,21 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing ! to it. !---------------------------------------------------------------------- - - ! Only data in the hyperslab will be written, other value should be fill value + + ! Only data in the hyperslab will be written, other value should be fill value CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F) CALL CHECK(" H5Dwrite_f", error, total_error) !---------------------------------------------------------------------- ! STEP 2: Try to read the data we just wrote. !---------------------------------------------------------------------- - + ! Read the dataset back - + CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F) CALL CHECK(" H5Dread_f", error, total_error) - ! Check that the values read are the same as the values written + ! Check that the values read are the same as the values written DO j = 1, INT(dims(2)) IF(new_data(1,j) .NE. orig_data(1,j))THEN total_error = total_error + 1 diff --git a/fortran/test/tH5O.F90 b/fortran/test/tH5O.F90 index fa3787e..e8a226e 100644 --- a/fortran/test/tH5O.F90 +++ b/fortran/test/tH5O.F90 @@ -77,22 +77,22 @@ 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" INTEGER(HID_T) :: tid, tid2 LOGICAL :: flag - + ! Data for tested h5ocopy_f CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1" INTEGER , PARAMETER :: dim0 = 4 INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer - INTEGER , DIMENSION(1:dim0) :: wdata2 ! Write buffer + INTEGER , DIMENSION(1:dim0) :: wdata2 ! Write buffer LOGICAL :: link_exists CHARACTER(LEN=8) :: chr_exact CHARACTER(LEN=10) :: chr_lg @@ -107,45 +107,45 @@ SUBROUTINE test_h5o_link(total_error) INTEGER(HSSIZE_T) :: comment_size INTEGER(SIZE_T) :: comment_size2 - ! Initialize the raw data + ! Initialize the raw data DO i = 1, TEST6_DIM1 DO j = 1, TEST6_DIM2 wdata(i,j) = i*j ENDDO ENDDO - ! Create the dataspace + ! Create the dataspace CALL h5screate_simple_f(2, dims, space_id, error) CALL check("h5screate_simple_f",error,total_error) - ! Create LCPL with intermediate group creation flag set + ! Create LCPL with intermediate group creation flag set CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error) CALL check("h5Pcreate_f",error,total_error) CALL H5Pset_create_inter_group_f(lcpl_id, TRUE, error) CALL check("H5Pset_create_inter_group_f",error,total_error) - ! Loop over using new group format + ! Loop over using new group format ! for(new_format = FALSE; new_format <= TRUE; new_format++) { - ! Make a FAPL that uses the "use the latest version of the format" bounds + ! Make a FAPL that uses the "use the latest version of the format" bounds CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,error) CALL check("h5Pcreate_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(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) - ! Create a new HDF5 file + ! Create a new HDF5 file CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) CALL check("H5Fcreate_f", error, total_error) - ! Close the FAPL + ! Close the FAPL CALL h5pclose_f(fapl_id, error) CALL check("h5pclose_f",error,total_error) - ! Create and commit a datatype with no name + ! Create and commit a datatype with no name CALL H5Tcopy_f( H5T_NATIVE_INTEGER, type_id, error) CALL check("H5Tcopy_F",error,total_error) @@ -160,22 +160,22 @@ SUBROUTINE test_h5o_link(total_error) CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters CALL check("H5Dcreate_anon_f",error,total_error) ! - ! Verify that we can write to and read from the dataset + ! Verify that we can write to and read from the dataset ! - ! Write the data to the dataset + ! Write the data to the dataset !EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, & !EP mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error) CALL check("h5dwrite_f", error, total_error) - ! Read the data back + ! Read the data back !EP CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, & !EP mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error) CALL check("h5dread_f", error, total_error) - ! Verify the data + ! Verify the data DO i = 1, TEST6_DIM1 DO j = 1, TEST6_DIM2 CALL verify("H5Dread_f",wdata(i,j),rdata(i,j),total_error) @@ -188,21 +188,21 @@ SUBROUTINE test_h5o_link(total_error) CALL H5Gcreate_anon_f(file_id, group_id, error) CALL check("H5Gcreate_anon", error, total_error) - ! Link nameless datatype into nameless group + ! Link nameless datatype into nameless group CALL H5Olink_f(type_id, group_id, "datatype", error, H5P_DEFAULT_F) CALL check("H5Olink_f", error, total_error) - ! Link nameless dataset into nameless group with intermediate group + ! Link nameless dataset into nameless group with intermediate group CALL H5Olink_f(dset_id, group_id, "inter_group/dataset", error, lcpl_id, H5P_DEFAULT_F) CALL check("H5Olink_f", error, total_error) - ! Close IDs for dataset and datatype + ! Close IDs for dataset and datatype CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) CALL h5tclose_f(type_id, error) CALL check("h5tclose_f", error, total_error) - ! Re-open datatype using new link + ! Re-open datatype using new link CALL H5Topen_f(group_id, "datatype", type_id, error) CALL check("h5topen_f", error, total_error) @@ -213,30 +213,30 @@ SUBROUTINE test_h5o_link(total_error) CALL h5gclose_f(group_id, error) CALL check("h5gclose_f",error,total_error) - ! Open dataset through root group and verify its data + ! Open dataset through root group and verify its data CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error) CALL check("test_lcpl.h5dopen_f", error, total_error) - ! Read data from dataset + ! Read data from dataset !EP CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, & !EP H5S_ALL_F, H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error) CALL check("h5dread_f", error, total_error) - ! Verify the data + ! Verify the data DO i = 1, TEST6_DIM1 DO j = 1, TEST6_DIM2 CALL verify("H5Dread",wdata(i,j),rdata(i,j),total_error) ENDDO ENDDO - ! Close open IDs + ! Close open IDs CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) CALL h5tclose_f(type_id, error) CALL check("h5tclose_f",error,total_error) - ! Close remaining IDs + ! Close remaining IDs CALL h5sclose_f(space_id, error) CALL check("h5sclose_f",error,total_error) CALL h5pclose_f(lcpl_id,error) @@ -270,7 +270,7 @@ SUBROUTINE test_h5o_link(total_error) comment_lg = ' ' - CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3", comment_lg, error) + CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3", comment_lg, error) CALL check("h5oget_comment_by_name_f", error, total_error) IF(comment_lg(1:13).NE.grp_comment)THEN @@ -287,7 +287,7 @@ SUBROUTINE test_h5o_link(total_error) comment_lg = ' ' - CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3"//' ', comment_lg, error) + CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3"//' ', comment_lg, error) CALL check("h5oget_comment_by_name_f", error, total_error) IF(comment_lg(1:13).NE.grp_comment)THEN @@ -309,7 +309,7 @@ SUBROUTINE test_h5o_link(total_error) ! Try reading into a buffer that is the correct size - CALL h5oget_comment_f(dset_id, comment, error) + CALL h5oget_comment_f(dset_id, comment, error) CALL check("h5oget_comment_f", error, total_error) IF(comment(1:15).NE.dset_comment(1:15))THEN @@ -318,18 +318,18 @@ SUBROUTINE test_h5o_link(total_error) ! Try reading into a buffer that is to small - CALL h5oget_comment_f(dset_id, comment_sm, error) + CALL h5oget_comment_f(dset_id, comment_sm, error) CALL check("h5oget_comment_f", error, total_error) IF(comment_sm(1:10).NE.dset_comment(1:10))THEN CALL check("h5oget_comment_f", -1, total_error) - ENDIF + ENDIF ! Try reading into a buffer that is larger then needed comment_lg = ' ' - CALL h5oget_comment_f(dset_id, comment_lg, error) + CALL h5oget_comment_f(dset_id, comment_lg, error) CALL check("h5oget_comment_f", error, total_error) IF(comment_lg(1:15).NE.dset_comment)THEN @@ -341,7 +341,7 @@ SUBROUTINE test_h5o_link(total_error) ! ! Check optional parameter ! - CALL h5oget_comment_f(dset_id, comment_lg, error, comment_size) + CALL h5oget_comment_f(dset_id, comment_lg, error, comment_size) CALL check("h5oget_comment_f", error, total_error) IF( comment_size.NE.15)THEN @@ -352,7 +352,7 @@ SUBROUTINE test_h5o_link(total_error) ! Try reading into a buffer that is the correct size - CALL h5oget_comment_by_name_f(dset_id, ".", comment, error) + CALL h5oget_comment_by_name_f(dset_id, ".", comment, error) CALL check("h5oget_comment_by_name_f", error, total_error) IF(comment(1:15).NE.dset_comment(1:15))THEN @@ -361,7 +361,7 @@ SUBROUTINE test_h5o_link(total_error) ! Try with trailing blanks in the name - CALL h5oget_comment_by_name_f(dset_id, ". ", comment, error) + CALL h5oget_comment_by_name_f(dset_id, ". ", comment, error) CALL check("h5oget_comment_by_name_f", error, total_error) IF(comment(1:15).NE.dset_comment(1:15))THEN @@ -371,7 +371,7 @@ SUBROUTINE test_h5o_link(total_error) ! ! Check optional parameter ! - CALL h5oget_comment_by_name_f(dset_id, ". ", comment_lg, error, comment_size2) + CALL h5oget_comment_by_name_f(dset_id, ". ", comment_lg, error, comment_size2) CALL check("h5oget_comment_by_name_f", error, total_error) IF( comment_size2.NE.15)THEN @@ -481,7 +481,7 @@ SUBROUTINE test_h5o_link(total_error) CALL h5gclose_f(group_id, error) CALL check("h5gclose_f", error, total_error) - ! Test opening an object by index, note + ! Test opening an object by index, note CALL h5oopen_by_idx_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, error) CALL check("h5oopen_by_idx_f", error, total_error) @@ -508,13 +508,13 @@ SUBROUTINE test_h5o_link(total_error) CALL h5pcreate_f(H5P_OBJECT_COPY_F, ocpypl_id, error) CALL check("h5Pcreate_f",error,total_error) - CALL h5pset_copy_object_f(ocpypl_id, H5O_COPY_SHALLOW_HIERARCHY_F, error) + CALL h5pset_copy_object_f(ocpypl_id, H5O_COPY_SHALLOW_HIERARCHY_F, error) CALL check("H5Pset_copy_object_f",error,total_error) - CALL h5ocopy_f(file_id, "/G1/G2", file_id, "/G1/G_cp2", error, ocpypl_id=ocpypl_id) + CALL h5ocopy_f(file_id, "/G1/G2", file_id, "/G1/G_cp2", error, ocpypl_id=ocpypl_id) CALL check("h5ocopy_f",error,total_error) - ! Makes sure the "DS1" dataset was not copied since we set a + ! Makes sure the "DS1" dataset was not copied since we set a ! flag to copy only immediate members of a group. ! Therefore, this should fail. CALL h5dopen_f(file_id, "/G1/G_cp2/DS1", dset_id, error) @@ -578,31 +578,31 @@ SUBROUTINE test_h5o_plist(total_error) IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: fid ! HDF5 File ID - INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers - INTEGER(hid_t) :: fapl ! File access property list - INTEGER(hid_t) :: gcpl, dcpl, tcpl ! Object creation properties - INTEGER :: def_max_compact, def_min_dense ! Default phase change parameters - INTEGER :: max_compact, min_dense ! Actual phase change parameters - INTEGER :: error ! Value returned from API calls + INTEGER(hid_t) :: fid ! HDF5 File ID + INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers + INTEGER(hid_t) :: fapl ! File access property list + INTEGER(hid_t) :: gcpl, dcpl, tcpl ! Object creation properties + INTEGER :: def_max_compact, def_min_dense ! Default phase change parameters + INTEGER :: max_compact, min_dense ! Actual phase change parameters + INTEGER :: error ! Value returned from API calls CHARACTER(LEN=7), PARAMETER :: TEST_FILENAME = 'test.h5' ! PRINT*,'Testing object creation properties' - ! Make a FAPL that uses the "use the latest version of the format" flag + ! Make a FAPL that uses the "use the latest version of the format" flag CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) CALL check("H5Pcreate_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(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pcreate_f", error, total_error) - ! Create a new HDF5 file + ! Create a new HDF5 file CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl) CALL check("H5Fcreate_f", error, total_error) - ! Create group, dataset & named datatype creation property lists + ! Create group, dataset & named datatype creation property lists CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl, error) CALL check("H5Pcreate_f", error, total_error) CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) @@ -610,11 +610,11 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Pcreate_f(H5P_DATATYPE_CREATE_F, tcpl, error) CALL check("H5Pcreate_f", error, total_error) - ! Retrieve default attribute phase change values + ! Retrieve default attribute phase change values CALL H5Pget_attr_phase_change_f(gcpl, def_max_compact, def_min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) - ! Set non-default attribute phase change values on each creation property list + ! Set non-default attribute phase change values on each creation property list CALL H5Pset_attr_phase_change_f(gcpl, def_max_compact+1, def_min_dense-1, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) CALL H5Pset_attr_phase_change_f(dcpl, def_max_compact+1, def_min_dense-1, error) @@ -622,7 +622,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Pset_attr_phase_change_f(tcpl, def_max_compact+1, def_min_dense-1, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) - ! Retrieve attribute phase change values on each creation property list and verify + ! Retrieve attribute phase change values on each creation property list and verify CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) @@ -640,16 +640,16 @@ SUBROUTINE test_h5o_plist(total_error) ! Create a group, dataset, and committed datatype within the file, ! using the respective type of creation property lists. - ! + ! - ! Create the group anonymously and link it in + ! Create the group anonymously and link it in CALL H5Gcreate_anon_f(fid, grp, error, gcpl_id=gcpl) CALL check("H5Gcreate_anon_f", error, total_error) CALL H5Olink_f(grp, fid, "group", error) CALL check("H5Olink_f", error, total_error) - ! Commit the type inside the group anonymously and link it in + ! Commit the type inside the group anonymously and link it in CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error) CALL check("h5tcopy_f", error, total_error) @@ -659,11 +659,11 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Olink_f(dtype, fid, "datatype", error) CALL check("H5Olink_f", error, total_error) - ! Create the dataspace for the dataset. + ! Create the dataspace for the dataset. CALL h5screate_f(H5S_SCALAR_F, dspace, error) CALL check("h5screate_f",error,total_error) - ! Create the dataset anonymously and link it in + ! Create the dataset anonymously and link it in CALL H5Dcreate_anon_f(fid, H5T_NATIVE_INTEGER, dspace, dset, error, dcpl ) CALL check("H5Dcreate_anon_f",error,total_error) @@ -673,7 +673,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL h5sclose_f(dspace, error) CALL check("h5sclose_f",error,total_error) - ! Close current creation property lists + ! Close current creation property lists CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) @@ -681,7 +681,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL h5pclose_f(tcpl,error) CALL check("h5pclose_f", error, total_error) - ! Retrieve each object's creation property list + ! Retrieve each object's creation property list CALL H5Gget_create_plist_f(grp, gcpl, error) CALL check("H5Gget_create_plist", error, total_error) @@ -691,7 +691,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Dget_create_plist_f(dset, dcpl, error) CALL check("H5Dget_create_plist_f", error, total_error) - ! Retrieve attribute phase change values on each creation property list and verify + ! Retrieve attribute phase change values on each creation property list and verify CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) @@ -707,7 +707,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error) - ! Close current objects + ! Close current objects CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) @@ -724,11 +724,11 @@ SUBROUTINE test_h5o_plist(total_error) CALL check("h5dclose_f",error,total_error) CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! Re-open the file and check that the object creation properties persist + ! Re-open the file and check that the object creation properties persist CALL h5fopen_f(TEST_FILENAME, H5F_ACC_RDONLY_F, fid, error, access_prp=fapl) CALL check("H5fopen_f",error,total_error) - ! Re-open objects + ! Re-open objects CALL H5Gopen_f(fid, "group", grp, error) CALL check("h5gopen_f", error, total_error) @@ -738,7 +738,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Dopen_f(fid, "dataset", dset, error) CALL check("h5dopen_f", error, total_error) - ! Retrieve each object's creation property list + ! Retrieve each object's creation property list CALL H5Gget_create_plist_f(grp, gcpl, error) CALL check("H5Gget_create_plist", error, total_error) @@ -748,7 +748,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL H5Dget_create_plist_f(dset, dcpl, error) CALL check("H5Dget_create_plist_f", error, total_error) - ! Retrieve attribute phase change values on each creation property list and verify + ! Retrieve attribute phase change values on each creation property list and verify CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) @@ -764,7 +764,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL verify("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error) CALL verify("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error) - ! Close current objects + ! Close current objects CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) @@ -782,7 +782,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - ! Close the FAPL + ! Close the FAPL CALL H5Pclose_f(fapl, error) CALL check("H5Pclose_f", error, total_error) diff --git a/fortran/test/tH5O_F03.F90 b/fortran/test/tH5O_F03.F90 index 44c4bff..cb6273e 100644 --- a/fortran/test/tH5O_F03.F90 +++ b/fortran/test/tH5O_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5O APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -28,9 +28,9 @@ ! ***************************************** MODULE visit_cb - USE HDF5 + USE HDF5 USE, INTRINSIC :: ISO_C_BINDING - + IMPLICIT NONE INTEGER, PARAMETER :: info_size = 9 @@ -58,21 +58,151 @@ MODULE visit_cb TYPE, bind(c) :: ovisit_ud_t INTEGER :: idx ! Index in object visit structure TYPE(obj_visit_t), DIMENSION(1:info_size) :: info ! Pointer to the object visit structure to use + INTEGER :: field END TYPE ovisit_ud_t CONTAINS - INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo, op_data) bind(C) +! Compares the field values of a C H5O_info_t and a Fortran H5O_info_t. + + INTEGER FUNCTION compare_h5o_info_t( loc_id, oinfo_f, oinfo_c, field, full_f_field ) RESULT(status) + + IMPLICIT NONE + INTEGER(HID_T) :: loc_id + TYPE(h5o_info_t) :: oinfo_f + TYPE(c_h5o_info_t) :: oinfo_c + TYPE(H5O_TOKEN_T_F) :: token_c + INTEGER :: field + LOGICAL :: full_f_field ! All the fields of Fortran H5O_info_t where filled +! local + INTEGER(C_INT), DIMENSION(1:8) :: atime, btime, ctime, mtime + INTEGER :: cmp_value + INTEGER :: i + INTEGER :: ierr + + status = 0 + + IF( (field .EQ. H5O_INFO_BASIC_F).OR.(field .EQ. H5O_INFO_ALL_F) )THEN + IF( (oinfo_f%fileno.LE.0) .OR. (oinfo_c%fileno .NE. oinfo_f%fileno) )THEN + status = -1 + RETURN + ENDIF + token_c%token = oinfo_c%token%token + CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr); + IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN + status = -1 + RETURN + ENDIF + IF( (oinfo_f%type.LT.0) .OR. (oinfo_c%type .NE. oinfo_f%type) )THEN + status = -1 + RETURN + ENDIF + IF( (oinfo_f%rc.LT.0) .OR. (oinfo_c%rc .NE. oinfo_f%rc) )THEN + status = -1 + RETURN + ENDIF + + ENDIF + + IF((field .EQ. H5O_INFO_TIME_F).OR.(field .EQ. H5O_INFO_ALL_F))THEN + + atime(1:8) = h5gmtime(oinfo_c%atime) + btime(1:8) = h5gmtime(oinfo_c%btime) + ctime(1:8) = h5gmtime(oinfo_c%ctime) + mtime(1:8) = h5gmtime(oinfo_c%mtime) + + DO i = 1, 8 + IF( (atime(i) .NE. oinfo_f%atime(i)) )THEN + status = -1 + RETURN + ENDIF + + IF( (btime(i) .NE. oinfo_f%btime(i)) )THEN + status = -1 + RETURN + ENDIF + + IF( (ctime(i) .NE. oinfo_f%ctime(i)) )THEN + status = -1 + RETURN + ENDIF + + IF( (mtime(i) .NE. oinfo_f%mtime(i)) )THEN + status = -1 + RETURN + ENDIF + ENDDO + + ELSE IF(field .EQ. H5O_INFO_TIME_F.AND. full_f_field)THEN + ! check other field values are not filled (using only a small subset to check) + status = 0 + IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1 + token_c%token = oinfo_c%token%token + CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr); + IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN + status = -1 + RETURN + ENDIF + IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1 + IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1 + IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled. + status = -1 + RETURN + ENDIF + status = 0 ! reset + ENDIF + + IF((field .EQ. H5O_INFO_NUM_ATTRS_F).OR.(field .EQ. H5O_INFO_ALL_F))THEN + IF( (oinfo_f%num_attrs.LT.0) .OR. (oinfo_c%num_attrs .NE. oinfo_f%num_attrs) )THEN + status = -1 + RETURN + ENDIF + ELSE IF( field .EQ. H5O_INFO_ALL_F.AND.full_f_field)THEN + ! check other field values are not filled (using only a small subset to check) + status = 0 + IF( oinfo_c%fileno .NE. oinfo_f%fileno) status = status + 1 + token_c%token = oinfo_c%token%token + CALL H5Otoken_cmp_f(loc_id, oinfo_f%token, token_c, cmp_value, ierr); + IF( (ierr .EQ. -1) .OR. (cmp_value .NE. 0) ) THEN + status = -1 + RETURN + ENDIF + IF( oinfo_c%type .NE. oinfo_f%type) status = status + 1 + IF( oinfo_c%rc .NE. oinfo_f%rc) status = status + 1 + IF(status.EQ.0) THEN ! There was no difference found, which is only possible if the field was filled. + status = -1 + RETURN + ENDIF + status = 0 ! reset + ENDIF + + END FUNCTION compare_h5o_info_t + + INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo_c, op_data) bind(C) IMPLICIT NONE INTEGER(HID_T), VALUE :: group_id CHARACTER(LEN=1), DIMENSION(1:180) :: name - TYPE(h5o_info_t) :: oinfo + CHARACTER(LEN=180) :: name2 + TYPE(c_h5o_info_t) :: oinfo_c TYPE(ovisit_ud_t) :: op_data - + TYPE(h5o_info_t) :: oinfo_f +! +! MEMBER | TYPE | MEANING | RANGE +! A(1) = tm_sec int seconds after the minute 0-61* +! A(2) = tm_min int minutes after the hour 0-59 +! A(3) = tm_hour int hours since midnight 0-23 +! A(4) = tm_mday int day of the month 1-31 +! A(5) = tm_mon int months since January 0-11 +! A(6) = tm_year int years since 1900 +! A(7) = tm_wday int days since Sunday 0-6 +! A(8) = tm_yday int days since January 1 0-365 +! A(9) = tm_isdst int Daylight Saving Time flag +! INTEGER :: len, i INTEGER :: idx + INTEGER :: ierr visit_obj_cb = 0 @@ -87,21 +217,53 @@ CONTAINS len = len - 1 ! Check for correct object information + name2(1:180) = "" + DO i = 1, len + name2(i:i) = name(i)(1:1) + ENDDO - idx = op_data%idx + IF(op_data%field .EQ. H5O_INFO_ALL_F)THEN - DO i = 1, len - IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN - visit_obj_cb = -1 - RETURN - ENDIF - - IF(op_data%info(idx)%type_obj .NE. oinfo%type)THEN - visit_obj_cb = -1 - RETURN - ENDIF + idx = op_data%idx - ENDDO + DO i = 1, len + IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN + visit_obj_cb = -1 + RETURN + ENDIF + + IF(op_data%info(idx)%type_obj .NE. oinfo_c%type)THEN + visit_obj_cb = -1 + RETURN + ENDIF + ENDDO + + ENDIF + + ! Check H5Oget_info_by_name_f; if partial field values were filled correctly + CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr); + visit_obj_cb = compare_h5o_info_t( group_id, oinfo_f, oinfo_c, op_data%field, .TRUE. ) + IF(visit_obj_cb.EQ.-1) RETURN + + ! Check H5Oget_info_by_name_f, only check field values + CALL H5Oget_info_by_name_f(group_id, name2, oinfo_f, ierr, fields = op_data%field); + visit_obj_cb = compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .FALSE. ) + IF(visit_obj_cb.EQ.-1) RETURN + + + IF(op_data%idx.EQ.1)THEN + + ! Check H5Oget_info_f, only check field values + CALL H5Oget_info_f(group_id, oinfo_f, ierr, fields = op_data%field); + visit_obj_cb = compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .FALSE. ) + IF(visit_obj_cb.EQ.-1) RETURN + + ! Check H5Oget_info_f; if partial field values where filled correctly + CALL H5Oget_info_f(group_id, oinfo_f, ierr); + visit_obj_cb = compare_h5o_info_t(group_id, oinfo_f, oinfo_c, op_data%field, .TRUE. ) + IF(visit_obj_cb.EQ.-1) RETURN + + ENDIF ! Advance to next location in expected output op_data%idx = op_data%idx + 1 @@ -110,7 +272,6 @@ CONTAINS END MODULE visit_cb - MODULE TH5O_F03 CONTAINS @@ -122,7 +283,7 @@ CONTAINS SUBROUTINE test_h5o_refcount(total_error) - USE HDF5 + USE HDF5 USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -140,7 +301,7 @@ SUBROUTINE test_h5o_refcount(total_error) ! Create a new HDF5 file CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) ! Create a group, dataset, and committed datatype within the file ! Create the group @@ -255,11 +416,11 @@ END SUBROUTINE test_h5o_refcount !**************************************************************** !** -!** test_h5o_refcount(): Test H5O visit functions. +!** test_obj_visit(): Test H5O visit functions. !** !**************************************************************** -SUBROUTINE obj_visit(total_error) +SUBROUTINE test_obj_visit(total_error) USE HDF5 USE TH5_MISC @@ -310,24 +471,77 @@ SUBROUTINE obj_visit(total_error) udata%info(9)%type_obj = H5O_TYPE_NAMED_DATATYPE_F ! Visit all the objects reachable from the root group (with file ID) - udata%idx = 1 fun_ptr = C_FUNLOC(visit_obj_cb) f_ptr = C_LOC(udata) ! Test h5ovisit_f + udata%field = H5O_INFO_ALL_F + udata%idx = 1 CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error) CALL check("h5ovisit_f", error, total_error) IF(ret_val.LT.0)THEN CALL check("h5ovisit_f", -1, total_error) ENDIF - ! Test h5ovisit_by_name_f + ! Test fields option + udata%field = H5O_INFO_ALL_F + udata%idx = 1 + CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + udata%field = H5O_INFO_BASIC_F + udata%idx = 1 + CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + udata%field = H5O_INFO_TIME_F + udata%idx = 1 + CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + udata%field = H5O_INFO_NUM_ATTRS_F + udata%idx = 1 + CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + ! Test h5ovisit_by_name_f object_name = "/" udata%idx = 1 + udata%field = H5O_INFO_ALL_F + CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_by_name_f", -1, total_error) + ENDIF - CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error) + ! Test fields option + udata%idx = 1 + udata%field = H5O_INFO_BASIC_F + CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_by_name_f", -1, total_error) + ENDIF + udata%idx = 1 + udata%field = H5O_INFO_TIME_F + CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) + CALL check("h5ovisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_by_name_f", -1, total_error) + ENDIF + udata%idx = 1 + udata%field = H5O_INFO_NUM_ATTRS_F + CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error, fields=udata%field) CALL check("h5ovisit_by_name_f", error, total_error) IF(ret_val.LT.0)THEN CALL check("h5ovisit_by_name_f", -1, total_error) @@ -336,15 +550,15 @@ SUBROUTINE obj_visit(total_error) CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error, total_error) -END SUBROUTINE obj_visit +END SUBROUTINE test_obj_visit !**************************************************************** !** -!** test_h5o_refcount(): Test H5O info functions. +!** test_obj_info(): Test H5O info functions. !** !**************************************************************** -SUBROUTINE obj_info(total_error) +SUBROUTINE test_obj_info(total_error) USE HDF5 USE TH5_MISC @@ -353,13 +567,13 @@ SUBROUTINE obj_info(total_error) INTEGER, INTENT(INOUT) :: total_error - INTEGER(hid_t) :: fid = -1 ! File ID - INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs - INTEGER(hid_t) :: did ! Dataset ID - INTEGER(hid_t) :: sid ! Dataspace ID - TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write + INTEGER(hid_t) :: fid = -1 ! File ID + INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs + INTEGER(hid_t) :: did ! Dataset ID + INTEGER(hid_t) :: sid ! Dataspace ID + TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read - TYPE(H5O_info_t) :: oinfo ! Object info struct + TYPE(H5O_info_t) :: oinfo ! Object info struct INTEGER :: error TYPE(C_PTR) :: f_ptr @@ -381,7 +595,7 @@ SUBROUTINE obj_info(total_error) CALL h5gcreate_f(fid, GROUPNAME, gid, error) CALL check("h5gcreate_f",error,total_error) - ! Create nested groups + ! Create nested groups CALL h5gcreate_f(gid, GROUPNAME2, gid2, error) CALL check("h5gcreate_f",error,total_error) CALL h5gclose_f(gid2, error) @@ -416,7 +630,7 @@ SUBROUTINE obj_info(total_error) CALL h5dwrite_f(did, H5T_STD_REF_OBJ, f_ptr, error) CALL check("h5dwrite_f",error, total_error) - ! Close objects + ! Close objects CALL h5dclose_f(did, error) CALL check("h5dclose_f", error, total_error) CALL h5sclose_f(sid, error) @@ -450,11 +664,32 @@ SUBROUTINE obj_info(total_error) IF(oinfo%rc.NE.1)THEN CALL check("h5oget_info_by_idx_f", -1, total_error) ENDIF + IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF + + ! Check partial fields + CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error, fields=H5O_INFO_BASIC_F ) + CALL check("h5oget_info_by_idx_f", error, total_error) + IF(oinfo%rc.NE.1)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN CALL check("h5oget_info_by_idx_f", -1, total_error) ENDIF + CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error, fields=H5O_INFO_TIME_F ) + CALL check("h5oget_info_by_idx_f", error, total_error) + ! These field values should not be filled + IF(oinfo%rc.EQ.1)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF + IF(oinfo%type.EQ.H5O_TYPE_DATASET_F)THEN + CALL check("h5oget_info_by_idx_f", -1, total_error) + ENDIF + + ! Close objects CALL h5dclose_f(did, error) CALL check("h5dclose_f", error, total_error) @@ -463,7 +698,7 @@ SUBROUTINE obj_info(total_error) CALL h5fclose_f(fid, error) CALL check("h5fclose_f", error, total_error) -END SUBROUTINE obj_info +END SUBROUTINE test_obj_info !------------------------------------------------------------------------- ! Function: build_visit_file @@ -483,14 +718,15 @@ SUBROUTINE build_visit_file(fid) USE TH5_MISC IMPLICIT NONE - INTEGER(hid_t) :: fid ! File ID - INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs + INTEGER(hid_t) :: fid ! File ID + INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs INTEGER(hid_t) :: sid = -1 ! Dataspace ID INTEGER(hid_t) :: did = -1 ! Dataset ID INTEGER(hid_t) :: tid = -1 ! Datatype ID + INTEGER(hid_t) :: aid = -1, aid2 = -1, aid3 = -1 ! Attribute ID CHARACTER(LEN=20) :: filename = 'visit.h5' INTEGER :: error - + ! Create file for visiting CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error) @@ -500,6 +736,15 @@ SUBROUTINE build_visit_file(fid) ! Create nested group CALL H5Gcreate_f(gid, "Group2", gid2, error) + CALL H5Screate_f(H5S_SCALAR_F, sid, error) + CALL H5Acreate_f(gid2, "Attr1", H5T_NATIVE_INTEGER, sid, aid, error) + CALL H5Acreate_f(gid2, "Attr2", H5T_NATIVE_INTEGER, sid, aid2, error) + CALL H5Acreate_f(gid2, "Attr3", H5T_NATIVE_INTEGER, sid, aid3, error) + CALL H5Aclose_f(aid,error) + CALL H5Aclose_f(aid2,error) + CALL H5Aclose_f(aid3,error) + CALL H5Sclose_f(sid,error) + ! Close groups CALL h5gclose_f(gid2, error) CALL h5gclose_f(gid, error) diff --git a/fortran/test/tH5P.F90 b/fortran/test/tH5P.F90 index 563926b..7fe3971 100644 --- a/fortran/test/tH5P.F90 +++ b/fortran/test/tH5P.F90 @@ -25,7 +25,7 @@ ! !***** MODULE TH5P - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules USE TH5_MISC USE TH5_MISC_GEN @@ -37,11 +37,11 @@ SUBROUTINE external_test(cleanup, total_error) ! h5pset_external_f, h5pget_external_count_f, ! h5pget_external_f - + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - + CHARACTER(LEN=8), PARAMETER :: filename = "external" CHARACTER(LEN=80) :: fix_filename INTEGER(HID_T) :: file_id @@ -75,7 +75,7 @@ SUBROUTINE external_test(cleanup, total_error) ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - + CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) CALL check("h5pcreate_f", error, total_error) CALL h5pset_buffer_f(plist_id, buf_size, error) @@ -88,7 +88,7 @@ SUBROUTINE external_test(cleanup, total_error) ENDIF CALL h5pclose_f(plist_id, error) CALL check("h5pclose_f", error, total_error) - + CALL h5pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) CALL check("h5pcreate_f",error,total_error) cur_size(1) =100 @@ -103,7 +103,7 @@ SUBROUTINE external_test(cleanup, total_error) CALL h5dcreate_f(file_id, "dset1", H5T_NATIVE_INTEGER, space_id, & dataset_id, error, plist_id) CALL check("h5dcreate_f", error, total_error) - + CALL h5dclose_f(dataset_id, error) CALL check("h5dclose_f", error, total_error) CALL h5pclose_f(plist_id, error) @@ -111,11 +111,11 @@ SUBROUTINE external_test(cleanup, total_error) CALL h5sclose_f(space_id, error) CALL check("h5sclose_f", error, total_error) CALL h5fclose_f(file_id, error) - + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) CALL h5dopen_f(file_id, "dset1", dataset_id, error) CALL check("h5dopen_f",error,total_error) - + ! Read dataset creation information CALL h5dget_create_plist_f(dataset_id, plist_id, error) CALL check("h5dget_create_plist_f",error,total_error) @@ -138,7 +138,7 @@ SUBROUTINE external_test(cleanup, total_error) WRITE (*,*) "got external file size is not correct" total_error = total_error + 1 END IF - + CALL h5dclose_f(dataset_id, error) CALL check("h5dclose_f", error, total_error) CALL h5pclose_f(plist_id, error) @@ -152,15 +152,15 @@ SUBROUTINE external_test(cleanup, total_error) END SUBROUTINE external_test SUBROUTINE multi_file_test(cleanup, total_error) - + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - + CHARACTER(LEN=9), PARAMETER :: filename = "multidset" ! File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name - + INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier @@ -173,10 +173,10 @@ SUBROUTINE multi_file_test(cleanup, total_error) !INTEGER(HADDR_T), DIMENSION(0:H5FD_MEM_NTYPES_F) :: memb_addr LOGICAL :: relax = .TRUE. LOGICAL :: relax_out = .TRUE. - + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions INTEGER :: rank = 2 ! Dataset rank - + INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers INTEGER :: error ! Error flag INTEGER(HID_T) :: driver @@ -201,7 +201,7 @@ SUBROUTINE multi_file_test(cleanup, total_error) memb_addr(H5FD_MEM_LHEAP_F) = 0.3 memb_map(H5FD_MEM_OHDR_F) = H5FD_MEM_OHDR_F memb_addr(H5FD_MEM_OHDR_F) = 0.4 - + memb_name = ' ' memb_name(H5FD_MEM_SUPER_F) = '%s-s.h5' memb_name(H5FD_MEM_BTREE_F) = '%s-b.h5' @@ -218,7 +218,7 @@ SUBROUTINE multi_file_test(cleanup, total_error) dset_data(i,j) = (i-1)*6 + j END DO END DO - + ! ! Create a new file using default properties. ! @@ -244,8 +244,8 @@ SUBROUTINE multi_file_test(cleanup, total_error) ! CALL h5pget_cache_f(fapl, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, & rdcc_w0, error) - CALL check("h5pget_cache_f", error, total_error) - + CALL check("h5pget_cache_f", error, total_error) + ! ! Set cache to some number ! @@ -284,13 +284,13 @@ SUBROUTINE multi_file_test(cleanup, total_error) ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) - + ! ! Terminate access to the data space. ! CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f", error, total_error) - + ! ! Close the file. ! @@ -318,31 +318,31 @@ SUBROUTINE multi_file_test(cleanup, total_error) ! write(*,*) memb_name_out ! write(*,*) memb_addr_out ! CALL check("h5pget_fapl_multi_f", error, total_error) - + ! ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) - + ! ! Get the dataset type. ! CALL h5dget_type_f(dset_id, dtype_id, error) CALL check("h5dget_type_f", error, total_error) - + ! ! Get the data space. ! CALL h5dget_space_f(dset_id, dspace_id, error) CALL check("h5dget_space_f", error, total_error) - + ! ! Read the dataset. ! CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) CALL check("h5dread_f", error, total_error) - + ! !Compare the data. ! @@ -354,19 +354,19 @@ SUBROUTINE multi_file_test(cleanup, total_error) END IF END DO END DO - + ! ! End access to the dataset and release resources used by it. ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) - + ! ! Terminate access to the data space. ! CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f", error, total_error) - + ! ! Terminate access to the data type. ! @@ -383,7 +383,7 @@ SUBROUTINE multi_file_test(cleanup, total_error) CALL check("h5pclose_f", error, total_error) IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-b', H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) IF(cleanup) CALL h5_cleanup_f(filename//'.h5-g', H5P_DEFAULT_F, error) @@ -396,7 +396,7 @@ SUBROUTINE multi_file_test(cleanup, total_error) CALL check("h5_cleanup_f", error, total_error) IF(cleanup) CALL h5_cleanup_f(filename//'.h5-s', H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE multi_file_test @@ -419,31 +419,32 @@ END SUBROUTINE multi_file_test !------------------------------------------------------------------------- ! SUBROUTINE test_chunk_cache(cleanup, total_error) - + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error - + CHARACTER(LEN=14), PARAMETER :: filename="chunk_cache" CHARACTER(LEN=80) :: fix_filename - INTEGER(hid_t) :: fid = -1 ! File ID - INTEGER(hid_t) :: fapl_local = -1 ! Local fapl - INTEGER(hid_t) :: fapl_def = -1 ! Default fapl - INTEGER(hid_t) :: dcpl = -1 ! Dataset creation property list ID - INTEGER(hid_t) :: dapl1 = -1 ! Dataset access property list ID - INTEGER(hid_t) :: dapl2 = -1 ! Dataset access property list ID - INTEGER(hid_t) :: sid = -1 ! Dataspace ID - INTEGER(hid_t) :: dsid = -1 ! Dataset ID - INTEGER(hsize_t), DIMENSION(1:1) :: chunk_dim, NDIM = (/100/) ! Dataset and chunk dimensions - INTEGER(size_t) :: nslots_1, nslots_2, nslots_3, nslots_4 ! rdcc number of elements - INTEGER(size_t) :: nbytes_1, nbytes_2, nbytes_3, nbytes_4 ! rdcc number of bytes + INTEGER(hid_t) :: fid = -1 ! File ID + INTEGER(hid_t) :: fapl_local = -1 ! Local fapl + INTEGER(hid_t) :: fapl_def = -1 ! Default fapl + INTEGER(hid_t) :: dcpl = -1 ! Dataset creation property list ID + INTEGER(hid_t) :: dapl1 = -1 ! Dataset access property list ID + INTEGER(hid_t) :: dapl2 = -1 ! Dataset access property list ID + INTEGER(hid_t) :: sid = -1 ! Dataspace ID + INTEGER(hid_t) :: dsid = -1 ! Dataset ID + INTEGER(hsize_t), DIMENSION(1:1) :: chunk_dim, NDIM = (/100/) ! Dataset and chunk dimensions + INTEGER(size_t) :: nslots_1, nslots_2, nslots_3, nslots_4 ! rdcc number of elements + INTEGER(size_t) :: nbytes_1, nbytes_2, nbytes_3, nbytes_4 ! rdcc number of bytes INTEGER :: mdc_nelmts - INTEGER(size_t) ::nlinks ! Number of link traversals - REAL :: w0_1, w0_2, w0_3, w0_4 ! rdcc preemption policy + INTEGER(size_t) ::nlinks ! Number of link traversals + REAL :: w0_1, w0_2, w0_3, w0_4 ! rdcc preemption policy INTEGER :: error INTEGER(size_t) rdcc_nelmts INTEGER(size_t) rdcc_nbytes REAL :: rdcc_w0 + LOGICAL :: minimize ! Flag for minimized headers CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN @@ -451,7 +452,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) STOP ENDIF - ! Create a default fapl and dapl + ! Create a default fapl and dapl CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl_def, error) CALL check("H5Pcreate_f", error, total_error) CALL H5Pcreate_f(H5P_DATASET_ACCESS_F, dapl1, error) @@ -459,7 +460,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Verify that H5Pget_chunk_cache(dapl) returns the same values as are in ! the default fapl. - ! + ! CALL H5Pget_cache_f(fapl_def, mdc_nelmts, nslots_1, nbytes_1, w0_1, error) CALL check("H5Pget_cache_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl1, nslots_4, nbytes_4, w0_4, error) @@ -468,7 +469,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL verify("H5Pget_chunk_cache_f", nbytes_1, nbytes_4, total_error) CALL verify("H5Pget_chunk_cache_f", w0_1, w0_4, total_error) - ! Set a lapl property on dapl1 (to verify inheritance) + ! Set a lapl property on dapl1 (to verify inheritance) CALL H5Pset_nlinks_f(dapl1, 134_size_t , error) CALL check("H5Pset_nlinks_f", error, total_error) CALL H5Pget_nlinks_f(dapl1, nlinks, error) @@ -493,29 +494,29 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Pset_cache_f(fapl_local, 0, nslots_2, nbytes_2, w0_2, error) CALL check("H5Pset_cache_f", error, total_error) - ! Create file + ! Create file CALL H5Fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl_local) 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) - ! Set chunking + ! Set chunking chunk_dim(1) = 10 CALL H5Pset_chunk_f(dcpl, 1, chunk_dim, error) CALL check("H5Pset_chunk_f", error, total_error) - ! Create 1-D dataspace + ! Create 1-D dataspace ndim(1) = 100 CALL H5Screate_simple_f(1, ndim, sid, error) CALL check("H5Pcreate_f", error, total_error) - ! Create dataset with default dapl + ! Create dataset with default dapl CALL H5Dcreate_f(fid, "dset", H5T_NATIVE_INTEGER, sid, dsid, error, dcpl, H5P_DEFAULT_F, dapl1) CALL check("H5Pcreate_f", error, total_error) - - ! Retrieve dapl from dataset, verify cache values are the same as on fapl_local + + ! Retrieve dapl from dataset, verify cache values are the same as on fapl_local CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error) @@ -523,9 +524,9 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error) - CALL H5Pclose_f(dapl2,error) + CALL H5Pclose_f(dapl2,error) CALL check("H5Pclose_f", error, total_error) - + ! Set new values on dapl1. nbytes will be set to default, so the file ! property will override this setting @@ -536,7 +537,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Pset_chunk_cache_f(dapl1, nslots_3, nbytes_3, w0_3, error) CALL check("H5Pset_chunk_cache_f", error, total_error) - ! Close dataset, reopen with dapl1. Note the use of a dapl with H5Oopen + ! Close dataset, reopen with dapl1. Note the use of a dapl with H5Oopen CALL H5Dclose_f(dsid, error) CALL H5Oopen_f(fid, "dset", dsid, error, dapl1) @@ -571,11 +572,11 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL verify("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error) CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) CALL verify("H5Pget_chunk_cache_f", w0_2, w0_4, total_error) - CALL H5Pclose_f(dapl2,error) + CALL H5Pclose_f(dapl2,error) CALL check("H5Pclose_f", error, total_error) ! Similary, test use of H5Dcreate2 with H5P_DEFAULT - CALL H5Dclose_f(dsid, error) + CALL H5Dclose_f(dsid, error) CALL check("H5Dclose_f", error, total_error) CALL H5Dcreate_f(fid, "dset2", H5T_NATIVE_INTEGER, sid, dsid, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) @@ -598,7 +599,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pset_cache_f", error, total_error) ! Close and reopen file with new fapl_local - + CALL H5Dclose_f(dsid, error) CALL check("H5Dclose_f", error, total_error) CALL H5Fclose_f(fid,error) @@ -610,13 +611,13 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Verify that dapl2 retrieved earlier (using values from the old fapl) ! sets its values in the new file (test use of H5Dopen2 with a dapl) ! - + CALL h5dopen_f (fid, "dset", dsid, error, dapl2) CALL check("h5dopen_f", error, total_error) - + CALL H5Pclose_f(dapl2,error) CALL check("H5Pclose_f", error, total_error) ! Close dapl2, to avoid id leak - + CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error) @@ -648,6 +649,57 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL verify("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) CALL verify("H5Pget_chunk_cache_f", w0_3, w0_4, total_error) + ! Check that the dataset object header minimization hint + ! can be set and retrieved. + + ! H5P version + ! Check the default value + minimize = .TRUE. + CALL h5pget_dset_no_attrs_hint_f(dcpl, minimize, error) + CALL check("h5pget_dset_no_attrs_hint_f",error,total_error) + if(minimize .neqv. .FALSE.) then + total_error = total_error + 1 + write(*,*) "Default dataset minimize flag was incorrect (H5P)" + endif + + ! Check setter + minimize = .TRUE. + CALL h5pset_dset_no_attrs_hint_f(dcpl, minimize, error) + CALL check("h5pset_dset_no_attrs_hint_f",error,total_error) + + ! Check getter + minimize = .FALSE. + CALL h5pget_dset_no_attrs_hint_f(dcpl, minimize, error) + CALL check("h5pget_dset_no_attrs_hint_f",error,total_error) + if(minimize .neqv. .TRUE.) then + total_error = total_error + 1 + write(*,*) "Unable to get correct dataset minimize flag (H5P)" + endif + + ! H5F version + ! Check the default value + minimize = .TRUE. + CALL h5fget_dset_no_attrs_hint_f(fid, minimize, error) + CALL check("h5fget_dset_no_attrs_hint_f",error,total_error) + if(minimize .neqv. .FALSE.) then + total_error = total_error + 1 + write(*,*) "Default dataset minimize flag was incorrect (H5F)" + endif + + ! Check setter + minimize = .TRUE. + CALL h5fset_dset_no_attrs_hint_f(fid, minimize, error) + CALL check("h5fset_dset_no_attrs_hint_f",error,total_error) + + ! Check getter + minimize = .FALSE. + CALL h5fget_dset_no_attrs_hint_f(fid, minimize, error) + CALL check("h5fget_dset_no_attrs_hint_f",error,total_error) + if(minimize .neqv. .TRUE.) then + total_error = total_error + 1 + write(*,*) "Unable to get correct dataset minimize flag (H5F)" + endif + ! Close CALL H5Dclose_f(dsid, error) @@ -655,15 +707,15 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Sclose_f(sid,error) CALL check("H5Sclose_f", error, total_error) CALL H5Pclose_f(fapl_local,error) - CALL check("H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(fapl_def,error) - CALL check("H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(dapl1,error) - CALL check("H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(dapl2,error) - CALL check("H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(dcpl,error) - CALL check("H5Pclose_f", error, total_error) + CALL check("H5Pclose_f", error, total_error) CALL H5Fclose_f(fid,error) CALL check("H5Fclose_f", error, total_error) diff --git a/fortran/test/tH5P_F03.F90 b/fortran/test/tH5P_F03.F90 index b44540b..3e7c552 100644 --- a/fortran/test/tH5P_F03.F90 +++ b/fortran/test/tH5P_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5P APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -40,35 +40,35 @@ MODULE test_genprop_cls_cb1_mod USE HDF5 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_ CONTAINS - + INTEGER FUNCTION test_genprop_cls_cb1_f(list_id, create_data ) bind(C) - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: list_id - + TYPE(cop_cb_struct_) :: create_data create_data%count = create_data%count + 1 create_data%id = list_id test_genprop_cls_cb1_f = 0 - + END FUNCTION test_genprop_cls_cb1_f END MODULE test_genprop_cls_cb1_mod MODULE TH5P_F03 - USE HDF5 - USE TH5_MISC + USE HDF5 + USE TH5_MISC USE TH5_MISC_GEN USE ISO_C_BINDING @@ -89,7 +89,7 @@ CONTAINS ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE test_create(total_error) @@ -112,12 +112,13 @@ SUBROUTINE test_create(total_error) INTEGER :: ifill REAL :: rfill REAL(KIND=dp) :: dpfill + INTEGER :: low, high ! ! * Create a file. - ! + ! CALL h5fcreate_f(filename,H5F_ACC_TRUNC_F,file,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) CALL h5screate_simple_f(5, cur_size, space, error, cur_size) CALL check("h5screate_simple_f", error, total_error) @@ -128,7 +129,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)) @@ -149,7 +150,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) @@ -204,17 +205,54 @@ 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 - CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("H5Pcreate_f",error, total_error) + ! 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) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V18_F, H5F_LIBVER_V18_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pget_libver_bounds_f(fapl, low, high, error) + CALL check("h5pget_libver_bounds_f",error, total_error) + CALL VERIFY("***ERROR: Returned wrong low libver_bounds", low, H5F_LIBVER_V18_F, total_error) + CALL VERIFY("***ERROR: Returned wrong high libver_bounds", high, H5F_LIBVER_V18_F, total_error) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V18_F, H5F_LIBVER_V110_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pget_libver_bounds_f(fapl, low, high, error) + CALL check("h5pget_libver_bounds_f",error, total_error) + CALL VERIFY("***ERROR: Returned wrong low libver_bounds", low, H5F_LIBVER_V18_F, total_error) + CALL VERIFY("***ERROR: Returned wrong high libver_bounds", high, H5F_LIBVER_V110_F, total_error) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V112_F, H5F_LIBVER_V112_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pget_libver_bounds_f(fapl, low, high, error) + CALL check("h5pget_libver_bounds_f",error, total_error) + CALL VERIFY("***ERROR: Returned wrong low libver_bounds", low, H5F_LIBVER_V112_F, total_error) + CALL VERIFY("***ERROR: Returned wrong high libver_bounds", high, H5F_LIBVER_V112_F, total_error) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V114_F, H5F_LIBVER_V114_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pget_libver_bounds_f(fapl, low, high, error) + CALL check("h5pget_libver_bounds_f",error, total_error) + CALL VERIFY("***ERROR: Returned wrong low libver_bounds", low, H5F_LIBVER_V114_F, total_error) + CALL VERIFY("***ERROR: Returned wrong high libver_bounds", high, H5F_LIBVER_V114_F, total_error) CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) + CALL h5pget_libver_bounds_f(fapl, low, high, error) + CALL check("h5pget_libver_bounds_f",error, total_error) + CALL VERIFY("***ERROR: Returned wrong low libver_bounds", low, H5F_LIBVER_LATEST_F, total_error) + CALL VERIFY("***ERROR: Returned wrong high libver_bounds", high, H5F_LIBVER_LATEST_F, total_error) + IF(H5F_LIBVER_LATEST_F.GE.H5F_LIBVER_NBOUNDS_F)THEN + WRITE(*,'(A,I0,A,I0,A)') & + "***ERROR: H5F_LIBVER_LATEST_F (",H5F_LIBVER_LATEST_F,") .GE. H5F_LIBVER_NBOUNDS_F (",H5F_LIBVER_NBOUNDS_F,")" + total_error = total_error + 1 + ENDIF 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) @@ -268,9 +306,9 @@ SUBROUTINE test_genprop_class_callback(total_error) INTEGER, INTENT(INOUT) :: total_error - 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 + 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 INTEGER :: CLASS1_NAME_SIZE = 7 ! length of class string @@ -291,7 +329,7 @@ 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) @@ -300,45 +338,45 @@ 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 + ! 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) - ! Get the list's class + ! 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 + ! Check that the list's class is correct CALL H5Pequal_f(cid2, cid1, flag, error) CALL check("H5Pequal_f", error, total_error) CALL verify("H5Pequal_f", flag, .TRUE., total_error) @@ -351,41 +389,41 @@ SUBROUTINE test_genprop_class_callback(total_error) WRITE(*,*) 'Class names do not match! name=',CLASS1_NAME_BUF, 'CLASS1_NAME=',CLASS1_NAME total_error = total_error + 1 ENDIF - ! Close class + ! Close class CALL h5pclose_class_f(cid2, error) CALL check("h5pclose_class_f", error, total_error) - ! Verify that the creation callback occurred + ! Verify that the creation callback occurred CALL verify("h5pcreate_f", crt_cb_struct%count, 1, total_error) CALL verify("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", 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", 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) @@ -393,7 +431,7 @@ SUBROUTINE test_genprop_class_callback(total_error) CALL verify("h5pcreate_f", cls_cb_struct%count, 2, total_error) CALL verify("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) @@ -421,7 +459,7 @@ SUBROUTINE test_h5p_file_image(total_error) INTEGER, PARAMETER :: count = 10 INTEGER, DIMENSION(1:count), TARGET :: buffer INTEGER, DIMENSION(1:count), TARGET :: temp - INTEGER :: i + INTEGER :: i INTEGER(size_t) :: size INTEGER(size_t) :: temp_size INTEGER :: error ! error return value @@ -451,7 +489,7 @@ SUBROUTINE test_h5p_file_image(total_error) CALL h5pset_file_image_f(fapl_1, f_ptr, size, error) CALL check("h5pset_file_image_f", error, total_error) - + ! Get the same data back DO i = 1, count f_ptr1(i) = C_LOC(temp(i)) @@ -463,7 +501,7 @@ SUBROUTINE test_h5p_file_image(total_error) ! Check that sizes are the same, and that the buffers are identical but separate CALL verify("h5pget_file_image_f", INT(temp_size), INT(size), total_error) - + ! Verify the image data is correct DO i = 1, count CALL verify("h5pget_file_image_f", temp(i), buffer(i), total_error) @@ -491,18 +529,18 @@ SUBROUTINE external_test_offset(cleanup,total_error) LOGICAL, INTENT(IN) :: cleanup INTEGER(hid_t) :: fapl=-1 ! file access property list - INTEGER(hid_t) :: file=-1 ! file to write to - INTEGER(hid_t) :: dcpl=-1 ! dataset creation properties - INTEGER(hid_t) :: space=-1 ! data space - INTEGER(hid_t) :: dset=-1 ! dataset + INTEGER(hid_t) :: file=-1 ! file to write to + INTEGER(hid_t) :: dcpl=-1 ! dataset creation properties + INTEGER(hid_t) :: space=-1 ! data space + INTEGER(hid_t) :: dset=-1 ! dataset INTEGER(hid_t) :: grp=-1 ! group to emit diagnostics - INTEGER(size_t) :: i, j ! miscellaneous counters + INTEGER(size_t) :: i, j ! miscellaneous counters CHARACTER(LEN=180) :: filename ! file names INTEGER, DIMENSION(1:25) :: part - INTEGER, DIMENSION(1:100), TARGET :: whole ! raw data buffers - INTEGER(hsize_t), DIMENSION(1:1) :: cur_size ! current data space size - INTEGER(hid_t) :: hs_space ! hyperslab data space - INTEGER(hsize_t), DIMENSION(1:1) :: hs_start = (/30/) ! hyperslab starting offset + INTEGER, DIMENSION(1:100), TARGET :: whole ! raw data buffers + INTEGER(hsize_t), DIMENSION(1:1) :: cur_size ! current data space size + INTEGER(hid_t) :: hs_space ! hyperslab data space + INTEGER(hsize_t), DIMENSION(1:1) :: hs_start = (/30/) ! hyperslab starting offset INTEGER(hsize_t), DIMENSION(1:1) :: hs_count = (/25/) ! hyperslab size CHARACTER(LEN=1) :: ichr1 ! character conversion holder INTEGER :: error ! error status @@ -521,23 +559,23 @@ SUBROUTINE external_test_offset(cleanup,total_error) WRITE(ichr1,'(I1.1)') i filename = "extern_"//ichr1//"a.raw" OPEN(10, FILE=filename, ACCESS='STREAM', form='UNFORMATTED') - + WRITE(10) temparray(1:(i-1)*10) WRITE(10) part CLOSE(10) ENDDO ! - ! Create the file and an initial group. + ! Create the file and an initial group. CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) CALL h5fcreate_f('extren_raw.h5', H5F_ACC_TRUNC_F, file, error, access_prp=fapl) CALL check("h5fcreate_f",error,total_error) - + CALL h5gcreate_f(file, "emit-diagnostics", grp, error) CALL check("h5gcreate_f",error, total_error) - + ! Create the dataset - sizeof_part = INT(H5_SIZEOF(part(1))*25, hsize_t) + sizeof_part = INT(H5_SIZEOF(part(1))*25, hsize_t) CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) CALL check("h5pcreate_f", error, total_error) @@ -549,7 +587,7 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL check("h5pset_external_f",error,total_error) CALL h5pset_external_f(dcpl, "extern_4a.raw", INT(30,off_t), sizeof_part, error) CALL check("h5pset_external_f",error,total_error) - + cur_size(1) = 100 CALL h5screate_simple_f(1, cur_size, space, error) CALL check("h5screate_simple_f", error, total_error) @@ -591,7 +629,7 @@ SUBROUTINE external_test_offset(cleanup,total_error) EXIT ENDIF ENDDO - + CALL h5dclose_f(dset, error) CALL check("h5dclose_f", error, total_error) CALL h5pclose_f(dcpl, error) @@ -640,12 +678,12 @@ SUBROUTINE test_vds(total_error) CHARACTER(LEN=3), PARAMETER :: DATASET="VDS" INTEGER(hsize_t) :: VDSDIM0 INTEGER(hsize_t), PARAMETER :: VDSDIM1 = 10 - INTEGER(hsize_t), PARAMETER :: VDSDIM2 = 15 + INTEGER(hsize_t), PARAMETER :: VDSDIM2 = 15 INTEGER(hsize_t) :: DIM0 INTEGER, PARAMETER :: DIM0_1= 4 ! Initial size of the source datasets - INTEGER, PARAMETER :: DIM1 = 10 - INTEGER, PARAMETER :: DIM2 = 15 + INTEGER, PARAMETER :: DIM1 = 10 + INTEGER, PARAMETER :: DIM2 = 15 INTEGER, PARAMETER :: RANK = 3 INTEGER(hsize_t), PARAMETER :: PLANE_STRIDE = 4 @@ -671,15 +709,15 @@ SUBROUTINE test_vds(total_error) src_count, block INTEGER(hsize_t), DIMENSION(1:2,1:3) :: vdsdims_out_correct - INTEGER(hsize_t), DIMENSION(1:3) :: start_out, & !Hyperslab PARAMETER out + INTEGER(hsize_t), DIMENSION(1:3) :: start_out, & !Hyperslab PARAMETER out stride_out, count_out, block_out INTEGER(hsize_t), DIMENSION(1:3,1:PLANE_STRIDE) :: start_correct INTEGER :: i, j - INTEGER(size_t) :: i_sz + INTEGER(size_t) :: i_sz INTEGER :: layout ! Storage layout - INTEGER(size_t) :: num_map ! Number of mappings - INTEGER(size_t) :: len ! Length of the string also a RETURN value + INTEGER(size_t) :: num_map ! Number of mappings + INTEGER(size_t) :: len ! Length of the string also a RETURN value ! Different sized character buffers CHARACTER(len=LEN(SRC_FILE(1))-3) :: SRC_FILE_LEN_TINY CHARACTER(len=LEN(SRC_FILE(1))-1) :: SRC_FILE_LEN_SMALL @@ -688,7 +726,7 @@ SUBROUTINE test_vds(total_error) CHARACTER(len=LEN(SRC_FILE(1))+10) :: SRC_FILE_LEN_HUGE CHARACTER(len=LEN(SRC_DATASET(1))) :: SRC_DATASET_LEN_EXACT - INTEGER(HID_T) :: space_out + INTEGER(HID_T) :: space_out INTEGER :: s_type, virtual_view INTEGER :: type1, type2 @@ -697,13 +735,13 @@ SUBROUTINE test_vds(total_error) TYPE(C_PTR) :: f_ptr INTEGER(SIZE_T) :: nsize LOGICAL :: IsRegular - INTEGER(HSIZE_T) :: gap_size + INTEGER(HSIZE_T) :: gap_size ! For testing against vdsdims_out_correct(1,1) = DIM0_1*5 vdsdims_out_correct(2,1) = DIM0_1*8 - vdsdims_out_correct(1:2,2) = VDSDIM1 - vdsdims_out_correct(1:2,3) = VDSDIM2 + vdsdims_out_correct(1:2,2) = VDSDIM1 + vdsdims_out_correct(1:2,3) = VDSDIM2 VDSDIM0 = H5S_UNLIMITED_F DIM0 = H5S_UNLIMITED_F @@ -711,7 +749,7 @@ SUBROUTINE test_vds(total_error) dims_max = (/INT(DIM0,hsize_t), INT(DIM1,hsize_t), INT(DIM2,hsize_t)/) ! - ! Create source files and datasets. + ! Create source files and datasets. ! DO i = 1, PLANE_STRIDE ! @@ -720,7 +758,7 @@ SUBROUTINE test_vds(total_error) wdata(j) = i ENDDO ! - ! Create the source files and datasets. Write data to each dataset and + ! Create the source files and datasets. Write data to each dataset and ! close all resources. CALL h5fcreate_f(SRC_FILE(i), H5F_ACC_TRUNC_F, file, error) CALL check("h5fcreate_f", error, total_error) @@ -731,7 +769,7 @@ SUBROUTINE test_vds(total_error) CALL check("h5pcreate_f", error, total_error) CALL h5pset_chunk_f(dcpl, RANK, chunk_dims, error) CALL check("h5pset_chunk_f",error, total_error) - + CALL h5dcreate_f(file, SRC_DATASET(i), H5T_NATIVE_INTEGER, src_space, dset, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5dcreate_f",error, total_error) f_ptr = C_LOC(wdata(1)) @@ -757,20 +795,20 @@ SUBROUTINE test_vds(total_error) ! Create dataspaces for the source dataset. CALL H5Screate_simple_f(RANK, dims, src_space, error, dims_max) CALL check("H5Screate_simple_f", error, total_error) - + ! Create VDS creation property CALL H5Pcreate_f (H5P_DATASET_CREATE_F, dcpl, error) CALL check("H5Pcreate_f", error, total_error) - - ! Initialize hyperslab values + + ! Initialize hyperslab values start(1:3) = 0 - stride(1:3) = (/PLANE_STRIDE,1_hsize_t,1_hsize_t/) ! we will select every fifth plane in VDS + stride(1:3) = (/PLANE_STRIDE,1_hsize_t,1_hsize_t/) ! we will select every fifth plane in VDS count(1:3) = (/H5S_UNLIMITED_F,1_hsize_t,1_hsize_t/) src_count(1:3) = (/H5S_UNLIMITED_F,1_hsize_t,1_hsize_t/) block(1:3) = (/1, DIM1, DIM2/) - - ! - ! Build the mappings + + ! + ! Build the mappings ! start_correct = 0 CALL H5Sselect_hyperslab_f(src_space, H5S_SELECT_SET_F, start, src_count, error, block=block) @@ -789,10 +827,10 @@ SUBROUTINE test_vds(total_error) start(1) = start(1) + 1 ENDDO - CALL H5Sselect_none_f(vspace, error) + CALL H5Sselect_none_f(vspace, error) CALL check("H5Sselect_none_f", error, total_error) - ! Create a virtual dataset + ! Create a virtual dataset CALL H5Dcreate_f(vfile, DATASET, H5T_NATIVE_INTEGER, vspace, vdset, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("H5Dcreate_f", error, total_error) CALL H5Sclose_f(vspace, error) @@ -802,9 +840,9 @@ SUBROUTINE test_vds(total_error) CALL H5Pclose_f(dcpl, error) CALL check("H5Pclose_f", error, total_error) - ! Let's add data to the source datasets and check new dimensions for VDS + ! Let's add data to the source datasets and check new dimensions for VDS ! We will add only one plane to the first source dataset, two planes to the - ! second one, three to the third, and four to the forth. + ! second one, three to the third, and four to the forth. DO i = 1, PLANE_STRIDE ! @@ -814,15 +852,15 @@ SUBROUTINE test_vds(total_error) ENDDO ! - ! Open the source files and datasets. Append data to each dataset and + ! Open the source files and datasets. Append data to each dataset and ! close all resources. CALL H5Fopen_f (SRC_FILE(i), H5F_ACC_RDWR_F, file, error) CALL check("H5Fopen_f", error, total_error) CALL H5Dopen_f (file, SRC_DATASET(i), dset, error) CALL check("H5Dopen_f", error, total_error) extdims(1) = DIM0_1+i - CALL H5Dset_extent_f(dset, extdims, error) - CALL check("H5Dset_extent_f", error, total_error) + CALL H5Dset_extent_f(dset, extdims, error) + CALL check("H5Dset_extent_f", error, total_error) CALL H5Dget_space_f(dset, src_space, error) CALL check("H5Dget_space_f", error, total_error) @@ -832,13 +870,13 @@ SUBROUTINE test_vds(total_error) memdims(1) = i - CALL H5Screate_simple_f(RANK, memdims, mem_space, error) + CALL H5Screate_simple_f(RANK, memdims, mem_space, error) CALL check("H5Screate_simple_f", error, total_error) - CALL H5Sselect_hyperslab_f(src_space, H5S_SELECT_SET_F, start,count, error,block=block) + CALL H5Sselect_hyperslab_f(src_space, H5S_SELECT_SET_F, start,count, error,block=block) CALL check("H5Sselect_hyperslab_f", error, total_error) f_ptr = C_LOC(wdata(1)) - CALL H5Dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, error, mem_space, src_space, H5P_DEFAULT_F) + CALL H5Dwrite_f(dset, H5T_NATIVE_INTEGER, f_ptr, error, mem_space, src_space, H5P_DEFAULT_F) CALL check("H5Dwrite_f", error, total_error) CALL H5Sclose_f(src_space, error) CALL check("H5Sclose_f", error, total_error) @@ -850,38 +888,38 @@ SUBROUTINE test_vds(total_error) call H5Dclose_f(vdset, error) CALL check("H5Dclose_f", error, total_error) - call H5Fclose_f(vfile, error) + call H5Fclose_f(vfile, error) CALL check("H5Fclose_f", error, total_error) - + ! ! begin the read section ! ! Open file and dataset using the default properties. CALL H5Fopen_f(VFILENAME, H5F_ACC_RDONLY_F, vfile, error) - CALL check("H5Fopen_f", error, total_error) - - ! + CALL check("H5Fopen_f", error, total_error) + + ! ! Open VDS using different access properties to use max or ! min extents depending on the sizes of the underlying datasets CALL H5Pcreate_f(H5P_DATASET_ACCESS_F, dapl, error) - CALL check("H5Pcreate_f", error, total_error) + CALL check("H5Pcreate_f", error, total_error) DO i = 1, 2 IF(i.NE.1)THEN CALL H5Pset_virtual_view_f(dapl, H5D_VDS_LAST_AVAILABLE_F, error) - CALL check("H5Pset_virtual_view_f", error, total_error) + CALL check("H5Pset_virtual_view_f", error, total_error) ELSE CALL H5Pset_virtual_view_f(dapl, H5D_VDS_FIRST_MISSING_F, error) - CALL check("H5Pset_virtual_view_f", error, total_error) + CALL check("H5Pset_virtual_view_f", error, total_error) ENDIF - + CALL H5Dopen_f(vfile, DATASET, vdset, error, dapl) - CALL check("H5Dopen_f", error, total_error) + CALL check("H5Dopen_f", error, total_error) ! Let's get space of the VDS and its dimension we should get 32(or 20)x10x10 CALL H5Dget_space_f(vdset, vspace, error) - CALL check("H5Dget_space_f", error, total_error) + CALL check("H5Dget_space_f", error, total_error) CALL H5Sget_simple_extent_dims_f(vspace, vdsdims_out, vdsdims_max_out, error) CALL check("H5Sget_simple_extent_dims_f", error, total_error) @@ -889,12 +927,12 @@ SUBROUTINE test_vds(total_error) DO j = 1, RANK IF(vdsdims_out(j).NE.vdsdims_out_correct(i,j))THEN total_error = total_error + 1 - EXIT + EXIT ENDIF ENDDO CALL H5Pget_virtual_view_f(dapl, virtual_view, error) - CALL check("h5pget_virtual_view_f", error, total_error) + CALL check("h5pget_virtual_view_f", error, total_error) IF(i.EQ.1)THEN IF(virtual_view .NE. H5D_VDS_FIRST_MISSING_F)THEN @@ -904,10 +942,10 @@ SUBROUTINE test_vds(total_error) IF(virtual_view .NE. H5D_VDS_LAST_AVAILABLE_F)THEN total_error = total_error + 1 ENDIF - + ENDIF - ! Close + ! Close CALL H5Dclose_f(vdset, error) CALL check("H5Dclose_f", error, total_error) CALL H5Sclose_f(vspace, error) @@ -919,7 +957,7 @@ SUBROUTINE test_vds(total_error) ! ! Get creation property list and mapping properties. - ! + ! CALL H5Dget_create_plist_f (vdset, dcpl, error) CALL check("H5Dget_create_plist_f", error, total_error) @@ -935,7 +973,7 @@ SUBROUTINE test_vds(total_error) ! ! Find number of mappings. - + CALL H5Pget_virtual_count_f(dcpl, num_map, error) CALL check("H5Pget_virtual_count_f", error, total_error) @@ -943,7 +981,7 @@ SUBROUTINE test_vds(total_error) PRINT*,"Number of mappings is incorrect" total_error = total_error + 1 ENDIF - ! + ! ! Get mapping parameters for each mapping. ! DO i_sz = 1, num_map @@ -1067,7 +1105,7 @@ SUBROUTINE test_vds(total_error) PRINT*,"gapsize is incorrect" total_error = total_error + 1 ENDIF - + CALL H5Dclose_f(vdset, error) CALL check("H5Dclose_f", error, total_error) CALL H5Sclose_f(vspace, error) @@ -1076,7 +1114,7 @@ SUBROUTINE test_vds(total_error) CALL check("H5Pclose_f", error, total_error) CALL H5Fclose_f(vfile, error) CALL check("H5Fclose_f", error, total_error) - + END SUBROUTINE test_vds diff --git a/fortran/test/tH5R.F90 b/fortran/test/tH5R.F90 index f7cccfa..708d290 100644 --- a/fortran/test/tH5R.F90 +++ b/fortran/test/tH5R.F90 @@ -21,7 +21,7 @@ ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! NOTES -! Tests h5rcreate_f, h5rdereference_f, h5rget_name_f +! Tests h5rcreate_f, h5rdereference_f, h5rget_name_f ! and H5Rget_object_type functions ! ! CONTAINS SUBROUTINES @@ -262,20 +262,20 @@ SUBROUTINE refregtest(cleanup, total_error) INTEGER(HID_T) :: dsetv_id ! Dataset identifier INTEGER(HID_T) :: dsetr_id ! Dataset identifier INTEGER :: error -! TYPE(hdset_reg_ref_t_f) , DIMENSION(1:2), TARGET :: ref - TYPE(hdset_reg_ref_t_f) , DIMENSION(1:2) :: ref +! TYPE(hdset_reg_ref_t_f) , DIMENSION(1:2), TARGET :: ref + TYPE(hdset_reg_ref_t_f) , DIMENSION(1:2) :: ref TYPE(hdset_reg_ref_t_f) , DIMENSION(1:2) :: ref_out INTEGER(HSIZE_T), DIMENSION(2) :: ref_dim = (/0,0/) INTEGER(HSIZE_T), DIMENSION(2) :: data_dims ! = (/0,0/) INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! INTEGER(HSIZE_T), DIMENSION(2) :: start ! = (/0,0/) INTEGER(HSIZE_T), DIMENSION(2) :: count ! = (/0,0/) INTEGER :: rankr = 1 INTEGER :: rank = 2 -! INTEGER , DIMENSION(2,9), TARGET :: DATA - INTEGER , DIMENSION(2,9) :: DATA +! INTEGER , DIMENSION(2,9), TARGET :: DATA + INTEGER , DIMENSION(2,9) :: DATA INTEGER , DIMENSION(2,9) :: data_out = 0 INTEGER(HSIZE_T) , DIMENSION(2,3) :: coord INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points @@ -353,7 +353,7 @@ SUBROUTINE refregtest(cleanup, total_error) CALL check("h5sselect_hyperslab_f", error, total_error) ref(1)%ref(:) = 0 ! f_ptr = C_LOC(ref(1)) -! CALL h5rcreate_f(file_id, dsetnamev, 1, space_id, f_ptr, error) +! CALL h5rcreate_f(file_id, dsetnamev, 1, space_id, f_ptr, error) CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) CALL check("h5rcreate_f", error, total_error) diff --git a/fortran/test/tH5S.F90 b/fortran/test/tH5S.F90 index a4f5f4a..a839d8b 100644 --- a/fortran/test/tH5S.F90 +++ b/fortran/test/tH5S.F90 @@ -176,14 +176,14 @@ CONTAINS CALL check("h5sget_simple_extent_type_f", error, total_error) IF (classtype .NE. 1) write(*,*)"class type not H5S_SIMPLE_f" - ! + ! !set the copied space to none before extend the dimensions. ! CALL h5sset_extent_none_f(space2_id, error) CALL check("h5sset_extent_none_f", error, total_error) ! - !set the copied space to dim2 size. + !set the copied space to dim2 size. ! CALL h5sset_extent_simple_f(space2_id, rank2, dims2, maxdims2, error) CALL check("h5sset_extent_simple_f", error, total_error) diff --git a/fortran/test/tH5Sselect.F90 b/fortran/test/tH5Sselect.F90 index 8415bce..5f7ece7 100644 --- a/fortran/test/tH5Sselect.F90 +++ b/fortran/test/tH5Sselect.F90 @@ -26,12 +26,12 @@ ! h5sselect_none_f, h5sselect_valid_f, h5sselect_hyperslab_f, ! h5sget_select_bounds_f, h5sget_select_elem_pointlist_f, ! h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, -! h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f +! h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f ! ! CONTAINS SUBROUTINES ! test_select_hyperslab, test_select_element, test_basic_select, ! test_select_point, test_select_combine, test_select_bounds -! +! ! !***** MODULE TH5SSELECT @@ -1033,12 +1033,12 @@ CONTAINS !*************************************************************** SUBROUTINE test_select_point(cleanup, total_error) - + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: xfer_plist - + INTEGER, PARAMETER :: SPACE1_DIM1=3 INTEGER, PARAMETER :: SPACE1_DIM2=15 INTEGER, PARAMETER :: SPACE1_DIM3=13 @@ -1046,36 +1046,36 @@ SUBROUTINE test_select_point(cleanup, total_error) INTEGER, PARAMETER :: SPACE2_DIM2=26 INTEGER, PARAMETER :: SPACE3_DIM1=15 INTEGER, PARAMETER :: SPACE3_DIM2=26 - + INTEGER, PARAMETER :: SPACE1_RANK=3 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=80) :: fix_filename CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) @@ -1086,11 +1086,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 @@ -1101,20 +1101,20 @@ SUBROUTINE test_select_point(cleanup, total_error) !!$ for(i=0, tbuf=wbuf; i<SPACE2_DIM1; i++) !!$ 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; @@ -1129,7 +1129,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) @@ -1144,7 +1144,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; @@ -1160,8 +1160,8 @@ 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) @@ -1175,7 +1175,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; @@ -1191,8 +1191,8 @@ 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) @@ -1202,9 +1202,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)); !!$ @@ -1212,7 +1212,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; @@ -1228,7 +1228,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) @@ -1241,26 +1241,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; @@ -1275,7 +1275,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 @@ -1287,7 +1287,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; @@ -1302,7 +1302,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 @@ -1315,11 +1315,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); @@ -1327,19 +1327,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) @@ -1358,34 +1358,34 @@ END SUBROUTINE test_select_point !*************************************************************** SUBROUTINE test_select_combine(total_error) - + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER, PARAMETER :: SPACE7_RANK = 2 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" - CALL h5scopy_f(base_id, all_id, error) + ! Copy base dataspace and set selection to "all" + CALL h5scopy_f(base_id, all_id, error) CALL check("h5scopy_f", error, total_error) CALL H5Sselect_all_f(all_id, error) @@ -1395,8 +1395,8 @@ 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" - CALL h5scopy_f(base_id, none_id, error) + ! Copy base dataspace and set selection to "none" + CALL h5scopy_f(base_id, none_id, error) CALL check("h5scopy_f", error, total_error) CALL H5Sselect_none_f(none_id, error) @@ -1405,100 +1405,100 @@ SUBROUTINE test_select_combine(total_error) CALL H5Sget_select_type_f(none_id, 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) - - ! Copy "all" selection & space - CALL H5Scopy_f(all_id, space1, error) + + ! 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 iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(all_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(all_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & - icount, error, stride, iblock) + 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. + ! 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/) !!$ 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)), 5, total_error) @@ -1514,42 +1514,42 @@ 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 - CALL H5Scopy_f(all_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & - icount, error, stride, iblock) + 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. + ! 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/) !!$ CALL verify("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) @@ -1567,200 +1567,200 @@ 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 - CALL H5Scopy_f(all_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(none_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(none_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(none_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(none_id, space1, error) + ! 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 iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & - icount, error, stride, iblock) + 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 - CALL H5Scopy_f(none_id, space1, error) + ! 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 - iblock(1:2) = (/5,4/) !5 + iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & - icount, error, stride, iblock) + 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) CALL h5sclose_f(all_id, error) @@ -1778,7 +1778,7 @@ END SUBROUTINE test_select_combine !*************************************************************** SUBROUTINE test_select_bounds(total_error) - + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error @@ -1786,25 +1786,25 @@ SUBROUTINE test_select_bounds(total_error) INTEGER, PARAMETER :: SPACE11_DIM1=100 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) :: 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) @@ -1813,12 +1813,12 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), 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) @@ -1827,21 +1827,21 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1, hsize_t), total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2, hsize_t), 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; coord(1,3)= 96; coord(2,3)= 3; @@ -1850,7 +1850,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) @@ -1859,22 +1859,22 @@ SUBROUTINE test_select_bounds(total_error) CALL VERIFY("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-4,hsize_t), total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-4,hsize_t), 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) @@ -1883,22 +1883,22 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), INT(SPACE11_DIM1-2,hsize_t), total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), INT(SPACE11_DIM2-6,hsize_t), 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 block(1:2) = 5 - + CALL h5sselect_hyperslab_f(sid, H5S_SELECT_SET_F, start, & - count, error, stride, block) + 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) @@ -1907,21 +1907,21 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), 37_hsize_t, total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), 37_hsize_t, 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) @@ -1930,22 +1930,22 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), 42_hsize_t, total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), 35_hsize_t, 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 block(1:2) = 10 CALL h5sselect_hyperslab_f(sid, H5S_SELECT_OR_F, start, & - count, error, stride, block) + 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) @@ -1954,21 +1954,21 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), 50_hsize_t, total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), 50_hsize_t, 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) @@ -1977,12 +1977,12 @@ SUBROUTINE test_select_bounds(total_error) CALL verify("h5sget_select_bounds_f", high_bounds(1), 55_hsize_t, total_error) CALL verify("h5sget_select_bounds_f", high_bounds(2), 48_hsize_t, 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 a986ba6..51e1a23 100644 --- a/fortran/test/tH5T.F90 +++ b/fortran/test/tH5T.F90 @@ -113,7 +113,7 @@ CONTAINS INTEGER(HID_T) :: fixed_str1, fixed_str2 LOGICAL :: are_equal - INTEGER(SIZE_T), PARAMETER :: str_size = 10 + INTEGER(SIZE_T), PARAMETER :: str_size = 10 INTEGER(SIZE_T) :: query_size ! Test h5tcreate_f with H5T_STRING_F option: @@ -125,34 +125,34 @@ CONTAINS CALL check("h5tset_size_f", error, total_error) CALL h5tset_strpad_f(fixed_str1, H5T_STR_NULLTERM_F, error) CALL check("h5tset_strpad_f", error, total_error) - + CALL h5tcreate_f(H5T_STRING_F, str_size, fixed_str2, error) CALL check("h5tcreate_f", error, total_error) CALL h5tset_strpad_f(fixed_str2, H5T_STR_NULLTERM_F, error) CALL check("h5tset_strpad_f", error, total_error) - + CALL h5tequal_f(fixed_str1, fixed_str2, are_equal, error) IF(.NOT.are_equal)THEN CALL check("h5tcreate_f", -1, total_error) ENDIF - + CALL h5tget_size_f(fixed_str1, query_size, error) CALL check("h5tget_size_f", error, total_error) - + IF(query_size.NE.str_size)THEN CALL check("h5tget_size_f", -1, total_error) ENDIF - + CALL h5tget_size_f(fixed_str2, query_size, error) CALL check("h5tget_size_f", error, total_error) IF(query_size.NE.str_size)THEN CALL check("h5tget_size_f", -1, total_error) ENDIF - + CALL h5tclose_f(fixed_str1,error) CALL check("h5tclose_f", error, total_error) - + CALL h5tclose_f(fixed_str2,error) CALL check("h5tclose_f", error, total_error) data_dims(1) = dimsize @@ -526,7 +526,7 @@ CONTAINS CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) DO i = 1, dimsize - CALL VERIFY("h5dread_f:Wrong double precision data is read back", double_member_out(i), double_member(i), total_error) + CALL VERIFY("h5dread_f:Wrong double precision data is read back", double_member_out(i), double_member(i), total_error) ENDDO ! ! @@ -541,20 +541,20 @@ CONTAINS CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error) CALL check("h5dread_f", error, total_error) DO i = 1, dimsize - CALL VERIFY("h5dread_f:Wrong double precision data is read back", real_member_out(i), real_member(i), total_error) + CALL VERIFY("h5dread_f:Wrong double precision data is read back", real_member_out(i), real_member(i), total_error) ENDDO ! ! *----------------------------------------------------------------------- ! * 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) @@ -562,11 +562,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) @@ -886,7 +886,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) @@ -957,7 +957,7 @@ CONTAINS ! * Modifications: ! * ! *------------------------------------------------------------------------- -! +! SUBROUTINE test_derived_flt(cleanup, total_error) @@ -977,7 +977,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" diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90 index 800e84b..d047263 100644 --- a/fortran/test/tH5T_F03.F90 +++ b/fortran/test/tH5T_F03.F90 @@ -5,7 +5,7 @@ ! ! FUNCTION ! Test FORTRAN HDF5 H5T APIs which are dependent on FORTRAN 2003 -! features. +! features. ! ! COPYRIGHT ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -43,7 +43,7 @@ MODULE TH5T_F03 - USE HDF5 + USE HDF5 USE TH5_MISC USE TH5_MISC_GEN USE ISO_C_BINDING @@ -55,10 +55,10 @@ SUBROUTINE test_array_compound_atomic(total_error) IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error - ! 1-D dataset WITH fixed dimensions + ! 1-D dataset WITH fixed dimensions INTEGER, PARAMETER :: SPACE1_RANK = 1 INTEGER, PARAMETER :: SPACE1_DIM1 = 4 - ! 1-D array datatype + ! 1-D array datatype INTEGER, PARAMETER :: ARRAY1_RANK= 1 INTEGER, PARAMETER :: ARRAY1_DIM1= 4 CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray1.h5" @@ -68,26 +68,26 @@ SUBROUTINE test_array_compound_atomic(total_error) INTEGER :: i REAL :: f END TYPE s1_t - TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: wdata ! Information to write - TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Information read in - INTEGER(hid_t) :: fid1 ! HDF5 File IDs - INTEGER(hid_t) :: dataset ! Dataset ID - INTEGER(hid_t) :: sid1 ! Dataspace ID - INTEGER(hid_t) :: tid1 ! Array Datatype ID - INTEGER(hid_t) :: tid2 ! Compound Datatype ID + TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: wdata ! Information to write + TYPE(s1_t), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Information read in + INTEGER(hid_t) :: fid1 ! HDF5 File IDs + INTEGER(hid_t) :: dataset ! Dataset ID + INTEGER(hid_t) :: sid1 ! Dataspace ID + INTEGER(hid_t) :: tid1 ! Array Datatype ID + INTEGER(hid_t) :: tid2 ! Compound Datatype ID INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/) - INTEGER :: ndims ! Array rank for reading - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading - INTEGER :: nmemb ! Number of compound members - CHARACTER(LEN=20) :: mname ! Name of compound field - INTEGER(size_t) :: off ! Offset of compound field - INTEGER(hid_t) :: mtid ! Datatype ID for field - INTEGER :: i,j ! counting variables - - INTEGER :: error ! Generic RETURN value + INTEGER :: ndims ! Array rank for reading + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading + INTEGER :: nmemb ! Number of compound members + CHARACTER(LEN=20) :: mname ! Name of compound field + INTEGER(size_t) :: off ! Offset of compound field + INTEGER(hid_t) :: mtid ! Datatype ID for field + INTEGER :: i,j ! counting variables + + INTEGER :: error ! Generic RETURN value INTEGER :: namelen LOGICAL :: flag @@ -96,7 +96,7 @@ SUBROUTINE test_array_compound_atomic(total_error) ALLOCATE( wdata(1:SPACE1_DIM1,1:ARRAY1_DIM1) ) ALLOCATE( rdata(1:SPACE1_DIM1,1:ARRAY1_DIM1) ) - ! Initialize array data to write + ! Initialize array data to write DO i = 1, SPACE1_DIM1 DO j = 1, ARRAY1_DIM1 wdata(i,j)%i = i * 10 + j @@ -104,153 +104,153 @@ SUBROUTINE test_array_compound_atomic(total_error) ENDDO ENDDO - ! Create file + ! Create file CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error) CALL check("h5fcreate_f", error, total_error) - ! Create dataspace for datasets + ! Create dataspace for datasets CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error) CALL check("h5screate_simple_f", error, total_error) CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wdata(1,1)), C_LOC(wdata(2,1))), tid2, error) CALL check("h5tcreate_f", error, total_error) - ! Insert integer field + ! Insert integer field CALL h5tinsert_f(tid2, "i", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%i)), H5T_NATIVE_INTEGER, error) CALL check("h5tinsert_f", error, total_error) - ! Insert float field + ! Insert float field CALL h5tinsert_f(tid2, "f", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f)), H5T_NATIVE_REAL, error) CALL check("h5tinsert_f", error, total_error) - ! Create an array datatype to refer to + ! Create an array datatype to refer to CALL h5tarray_create_f(tid2, ARRAY1_RANK, tdims1, tid1, error) CALL check("h5tarray_create_f", error, total_error) - ! Close compound datatype + ! Close compound datatype CALL h5tclose_f(tid2,error) CALL check("h5tclose_f", error, total_error) - ! Create a dataset + ! Create a dataset CALL h5dcreate_f(fid1,"Dataset1",tid1, sid1, dataset,error) CALL check("h5dcreate_f", error, total_error) - ! Write dataset to disk + ! Write dataset to disk ALLOCATE(rdims(1:2)) ! dummy not needed f_ptr = C_LOC(wdata(1,1)) CALL h5dwrite_f(dataset, tid1, f_ptr, error ) CALL check("h5dwrite_f", error, total_error) - ! Close Dataset + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f", error, total_error) - ! Close datatype + ! Close datatype CALL h5tclose_f(tid1,error) CALL check("h5tclose_f", error, total_error) - ! Close disk dataspace + ! Close disk dataspace CALL h5sclose_f(sid1,error) CALL check("h5sclose_f", error, total_error) - ! Close file + ! Close file CALL h5fclose_f(fid1,error) CALL check("h5fclose_f", error, total_error) - ! Re-open file + ! Re-open file CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, fid1, error) CALL check("h5fopen_f", error, total_error) - ! Open the dataset + ! Open the dataset CALL h5dopen_f(fid1, "Dataset1", dataset, error) CALL check("h5dopen_f", error, total_error) - ! Get the datatype + ! Get the datatype CALL h5dget_type_f(dataset, tid1, error) CALL check("h5dget_type_f", error, total_error) - ! Check the array rank + ! Check the array rank CALL h5tget_array_ndims_f(tid1, ndims, error) CALL check("h5tget_array_ndims_f", error, total_error) CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error) - ! Get the array dimensions + ! Get the array dimensions ALLOCATE(rdims1(1:ndims)) CALL h5tget_array_dims_f(tid1, rdims1, error) CALL check("h5tget_array_dims_f", error, total_error) - ! Check the array dimensions + ! Check the array dimensions DO i = 1, ndims CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims1(i)), total_error) ENDDO - ! Get the compound datatype + ! Get the compound datatype CALL h5tget_super_f(tid1, tid2, error) CALL check("h5tget_super_f", error, total_error) - ! Check the number of members + ! Check the number of members CALL h5tget_nmembers_f(tid2, nmemb, error) CALL check("h5tget_nmembers_f", error, total_error) CALL VERIFY("h5tget_nmembers_f", nmemb, 2, total_error) - ! Check the 1st field's name + ! Check the 1st field's name CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error) CALL check("H5Tget_member_name_f", error, total_error) CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error) - ! Check the 1st field's offset + ! Check the 1st field's offset CALL H5Tget_member_offset_f(tid2, 0, off, error) CALL check("H5Tget_member_offset_f", error, total_error) - CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error) + CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error) - ! Check the 1st field's datatype + ! Check the 1st field's datatype CALL H5Tget_member_type_f(tid2, 0, mtid, error) CALL check("H5Tget_member_type_f", error, total_error) CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL verify("H5Tequal_f", flag, .TRUE., total_error) CALL h5tclose_f(mtid,error) CALL check("h5tclose_f", error, total_error) - ! Check the 2nd field's name + ! Check the 2nd field's name CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error) CALL check("H5Tget_member_name_f", error, total_error) CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error) - ! Check the 2nd field's offset + ! Check the 2nd field's offset CALL H5Tget_member_offset_f(tid2, 1, off, error) CALL check("H5Tget_member_offset_f", error, total_error) - CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error) + CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error) - ! Check the 2nd field's datatype + ! Check the 2nd field's datatype CALL H5Tget_member_type_f(tid2, 1, mtid, error) CALL check("H5Tget_member_type_f", error, total_error) CALL H5Tequal_f(mtid, H5T_NATIVE_REAL, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL verify("H5Tequal_f", flag, .TRUE., total_error) CALL h5tclose_f(mtid,error) CALL check("h5tclose_f", error, total_error) - ! Close Compound Datatype + ! Close Compound Datatype CALL h5tclose_f(tid2, error) CALL check("h5tclose_f", error, total_error) - ! Read dataset from disk + ! Read dataset from disk f_ptr = C_LOC(rdata(1,1)) CALL H5Dread_f(dataset, tid1, f_ptr, error, H5S_ALL_F, H5S_ALL_F, H5P_DEFAULT_F) CALL check("H5Dread_f", error, total_error) - ! Compare data read in + ! Compare data read in DO i = 1, SPACE1_DIM1 DO j = 1, ARRAY1_DIM1 IF(wdata(i,j)%i.NE.rdata(i,j)%i)THEN @@ -261,15 +261,15 @@ SUBROUTINE test_array_compound_atomic(total_error) ENDDO ENDDO - ! Close Datatype + ! Close Datatype CALL h5tclose_f(tid1,error) CALL check("h5tclose_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) @@ -283,12 +283,12 @@ END SUBROUTINE test_array_compound_atomic !!$!*************************************************************** !!$ SUBROUTINE test_array_compound_array(total_error) - + IMPLICIT NONE - + INTEGER, INTENT(INOUT) :: total_error - ! 1-D array datatype + ! 1-D array datatype INTEGER, PARAMETER :: ARRAY1_RANK= 1 INTEGER, PARAMETER :: ARRAY1_DIM1= 3 INTEGER, PARAMETER :: ARRAY2_DIM1= 5 @@ -303,47 +303,47 @@ END SUBROUTINE test_array_compound_atomic REAL, DIMENSION(1:ARRAY2_DIM1) :: f CHARACTER(LEN=2), DIMENSION(1:ARRAY2_DIM1) :: c END TYPE st_t_struct - ! Information to write + ! Information to write TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: wdata - ! Information read in + ! Information read in TYPE(st_t_struct), DIMENSION(1:SPACE1_DIM1,1:ARRAY1_DIM1), TARGET :: rdata - INTEGER(hid_t) :: fid1 ! HDF5 File IDs - INTEGER(hid_t) :: dataset ! Dataset ID - integer(hid_t) :: sid1 ! Dataspace ID - integer(hid_t) :: tid1 ! Array Datatype ID - integer(hid_t) :: tid2 ! Compound Datatype ID - integer(hid_t) :: tid3 ! Nested Array Datatype ID - integer(hid_t) :: tid4 ! Nested Array Datatype ID + INTEGER(hid_t) :: fid1 ! HDF5 File IDs + INTEGER(hid_t) :: dataset ! Dataset ID + integer(hid_t) :: sid1 ! Dataspace ID + integer(hid_t) :: tid1 ! Array Datatype ID + integer(hid_t) :: tid2 ! Compound Datatype ID + integer(hid_t) :: tid3 ! Nested Array Datatype ID + integer(hid_t) :: tid4 ! Nested Array Datatype ID INTEGER(HSIZE_T), DIMENSION(1) :: sdims1 = (/SPACE1_DIM1/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/ARRAY1_DIM1/) INTEGER(HSIZE_T), DIMENSION(1) :: tdims2=(/ARRAY2_DIM1/) - INTEGER ndims ! Array rank for reading + INTEGER ndims ! Array rank for reading - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading - INTEGER :: nmemb ! Number of compound members - CHARACTER(LEN=20) :: mname ! Name of compound field - INTEGER(size_t) :: off ! Offset of compound field - INTEGER(hid_t) :: mtid ! Datatype ID for field - INTEGER(hid_t) :: mtid2 ! Datatype ID for field + INTEGER :: nmemb ! Number of compound members + CHARACTER(LEN=20) :: mname ! Name of compound field + INTEGER(size_t) :: off ! Offset of compound field + INTEGER(hid_t) :: mtid ! Datatype ID for field + INTEGER(hid_t) :: mtid2 ! Datatype ID for field - INTEGER :: mclass ! Datatype class for field - INTEGER :: i,j,k ! counting variables + INTEGER :: mclass ! Datatype class for field + INTEGER :: i,j,k ! counting variables INTEGER :: error CHARACTER(LEN=2) :: ichr2 INTEGER :: namelen - LOGICAL :: flag + LOGICAL :: flag INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier - INTEGER(SIZE_T) :: attrlen ! Length of the attribute string + INTEGER(SIZE_T) :: attrlen ! Length of the attribute string TYPE(c_ptr) :: f_ptr - ! Initialize array data to write + ! Initialize array data to write DO i = 1, SPACE1_DIM1 DO j = 1, array1_DIM1 wdata(i,j)%i = i*10+j @@ -355,28 +355,28 @@ END SUBROUTINE test_array_compound_atomic ENDDO ENDDO - ! Create file + ! Create file CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) - ! Create dataspace for datasets + ! Create dataspace for datasets CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error) CALL check("h5screate_simple_f", error, total_error) - ! Create a compound datatype to refer to + ! Create a compound datatype to refer to ! CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(wdata(1,1)), C_LOC(wdata(2,1))), tid2, error) CALL check("h5tcreate_f", error, total_error) - ! Insert integer field + ! Insert integer field CALL h5tinsert_f(tid2, "i", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%i)), H5T_NATIVE_INTEGER, error) CALL check("h5tinsert_f", error, total_error) - ! Create an array of floats datatype + ! Create an array of floats datatype CALL h5tarray_create_f(H5T_NATIVE_REAL, ARRAY1_RANK, tdims2, tid3, error) CALL check("h5tarray_create_f", error, total_error) - ! Insert float array field + ! Insert float array field CALL h5tinsert_f(tid2, "f", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f)), tid3, error) CALL check("h5tinsert_f", error, total_error) @@ -386,227 +386,227 @@ END SUBROUTINE test_array_compound_atomic ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) CALL check("h5tcopy_f",error,total_error) - - attrlen = LEN(wdata(1,1)%c(1)) + + attrlen = LEN(wdata(1,1)%c(1)) CALL h5tset_size_f(atype_id, attrlen, error) - CALL check("h5tset_size_f",error,total_error) + CALL check("h5tset_size_f",error,total_error) - ! Create an array of character datatype + ! Create an array of character datatype CALL h5tarray_create_f(atype_id, ARRAY1_RANK, tdims2, tid4, error) CALL check("h5tarray_create_f", error, total_error) - ! Insert character array field + ! Insert character array field CALL h5tinsert_f(tid2, "c", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1))), tid4, error) CALL check("h5tinsert2_f", error, total_error) - ! Close array of floats field datatype + ! Close array of floats field datatype CALL h5tclose_f(tid3,error) CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(tid4,error) CALL check("h5tclose_f", error, total_error) - ! Create an array datatype to refer to + ! Create an array datatype to refer to CALL h5tarray_create_f(tid2, ARRAY1_RANK, tdims1, tid1, error) CALL check("h5tarray_create_f", error, total_error) - ! Close compound datatype + ! Close compound datatype CALL h5tclose_f(tid2,error) CALL check("h5tclose_f", error, total_error) - ! Create a dataset + ! Create a dataset CALL h5dcreate_f(fid1,"Dataset1",tid1, sid1, dataset,error) CALL check("h5dcreate_f", error, total_error) - ! Write dataset to disk + ! Write dataset to disk f_ptr = C_LOC(wdata(1,1)) CALL h5dwrite_f(dataset, tid1, f_ptr, error ) CALL check("h5dwrite_f", error, total_error) - ! Close Dataset + ! Close Dataset CALL h5dclose_f(dataset, error) CALL check("h5dclose_f", error, total_error) - ! Close datatype + ! Close datatype CALL h5tclose_f(tid1,error) CALL check("h5tclose_f", error, total_error) - ! Close disk dataspace + ! Close disk dataspace CALL h5sclose_f(sid1,error) CALL check("h5sclose_f", error, total_error) - ! Close file + ! Close file CALL h5fclose_f(fid1,error) CALL check("h5fclose_f", error, total_error) - ! Re-open file + ! Re-open file CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, fid1, error) CALL check("h5fopen_f", error, total_error) - ! Open the dataset + ! Open the dataset CALL h5dopen_f(fid1, "Dataset1", dataset, error) CALL check("h5dopen_f", error, total_error) - - ! Get the datatype + + ! Get the datatype CALL h5dget_type_f(dataset, tid1, error) CALL check("h5dget_type_f", error, total_error) - ! Check the array rank + ! Check the array rank CALL h5tget_array_ndims_f(tid1, ndims, error) CALL check("h5tget_array_ndims_f", error, total_error) CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error) - ! Get the array dimensions + ! Get the array dimensions ALLOCATE(rdims1(1:ndims)) CALL h5tget_array_dims_f(tid1, rdims1, error) CALL check("h5tget_array_dims_f", error, total_error) - ! Check the array dimensions + ! Check the array dimensions DO i = 1, ndims CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims1(i)), total_error) ENDDO - ! Get the compound datatype + ! Get the compound datatype CALL h5tget_super_f(tid1, tid2, error) CALL check("h5tget_super_f", error, total_error) - ! Check the number of members + ! Check the number of members CALL h5tget_nmembers_f(tid2, nmemb, error) CALL check("h5tget_nmembers_f", error, total_error) CALL VERIFY("h5tget_nmembers_f", nmemb, 3, total_error) - ! Check the 1st field's name + ! Check the 1st field's name CALL H5Tget_member_name_f(tid2, 0, mname, namelen,error) CALL check("H5Tget_member_name_f", error, total_error) CALL verify("H5Tget_member_name_f",mname(1:namelen),"i", total_error) - ! Check the 1st field's offset + ! Check the 1st field's offset CALL H5Tget_member_offset_f(tid2, 0, off, error) CALL check("H5Tget_member_offset_f", error, total_error) - CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error) + CALL VERIFY("H5Tget_member_offset_f",INT(off),0, total_error) - ! Check the 1st field's datatype + ! Check the 1st field's datatype CALL H5Tget_member_type_f(tid2, 0, mtid, error) CALL check("H5Tget_member_type_f", error, total_error) CALL H5Tequal_f(mtid, H5T_NATIVE_INTEGER, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL verify("H5Tequal_f", flag, .TRUE., total_error) CALL h5tclose_f(mtid,error) CALL check("h5tclose_f", error, total_error) - ! Check the 2nd field's name + ! Check the 2nd field's name CALL H5Tget_member_name_f(tid2, 1, mname, namelen,error) CALL check("H5Tget_member_name_f", error, total_error) CALL verify("H5Tget_member_name_f",mname(1:namelen),"f", total_error) - ! Check the 2nd field's offset + ! Check the 2nd field's offset CALL H5Tget_member_offset_f(tid2, 1, off, error) CALL check("H5Tget_member_offset_f", error, total_error) - CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error) + CALL VERIFY("H5Tget_member_offset_f",INT(off),INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%f))), total_error) - ! Check the 2nd field's datatype + ! Check the 2nd field's datatype CALL H5Tget_member_type_f(tid2, 1, mtid, error) CALL check("H5Tget_member_type_f", error, total_error) - ! Get the 2nd field's class + ! Get the 2nd field's class CALL H5Tget_class_f(mtid, mclass, error) CALL check("H5Tget_class_f", error, total_error) CALL VERIFY("H5Tget_class_f",mclass, H5T_ARRAY_F, total_error) - ! Check the array rank + ! Check the array rank CALL h5tget_array_ndims_f(mtid, ndims, error) CALL check("h5tget_array_ndims_f", error, total_error) CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error) - ! Get the array dimensions + ! Get the array dimensions CALL h5tget_array_dims_f(mtid, rdims1, error) CALL check("h5tget_array_dims_f", error, total_error) - ! Check the array dimensions + ! Check the array dimensions DO i = 1, ndims CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims2(i)), total_error) ENDDO - ! Check the 3rd field's name + ! Check the 3rd field's name CALL H5Tget_member_name_f(tid2, 2, mname, namelen,error) CALL check("H5Tget_member_name_f", error, total_error) CALL verify("H5Tget_member_name_f",mname(1:namelen),"c", total_error) - ! Check the 3rd field's offset + ! Check the 3rd field's offset CALL H5Tget_member_offset_f(tid2, 2, off, error) CALL check("H5Tget_member_offset_f", error, total_error) CALL VERIFY("H5Tget_member_offset_f",INT(off),& - INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1)))), total_error) + INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1)))), total_error) - ! Check the 3rd field's datatype + ! Check the 3rd field's datatype CALL H5Tget_member_type_f(tid2, 2, mtid2, error) CALL check("H5Tget_member_type_f", error, total_error) - ! Get the 3rd field's class + ! Get the 3rd field's class CALL H5Tget_class_f(mtid2, mclass, error) CALL check("H5Tget_class_f", error, total_error) CALL VERIFY("H5Tget_class_f",mclass, H5T_ARRAY_F, total_error) - ! Check the array rank + ! Check the array rank CALL h5tget_array_ndims_f(mtid2, ndims, error) CALL check("h5tget_array_ndims_f", error, total_error) CALL VERIFY("h5tget_array_ndims_f",ndims, ARRAY1_RANK, total_error) - ! Get the array dimensions + ! Get the array dimensions CALL h5tget_array_dims_f(mtid2, rdims1, error) CALL check("h5tget_array_dims_f", error, total_error) - ! Check the array dimensions + ! Check the array dimensions DO i = 1, ndims CALL VERIFY("h5tget_array_dims_f", INT(rdims1(i)), INT(tdims2(i)), total_error) ENDDO - ! Check the nested array's datatype + ! Check the nested array's datatype CALL H5Tget_super_f(mtid, tid3, error) CALL check("H5Tget_super_f", error, total_error) CALL H5Tequal_f(tid3, H5T_NATIVE_REAL, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL verify("H5Tequal_f", flag, .TRUE., total_error) - ! Check the nested array's datatype + ! Check the nested array's datatype CALL H5Tget_super_f(mtid2, tid3, error) CALL check("H5Tget_super_f", error, total_error) CALL H5Tequal_f(tid3, atype_id, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL verify("H5Tequal_f", flag, .TRUE., total_error) - ! Close the array's base type datatype + ! Close the array's base type datatype CALL h5tclose_f(tid3, error) CALL check("h5tclose_f", error, total_error) - ! Close the member datatype + ! Close the member datatype CALL h5tclose_f(mtid,error) CALL check("h5tclose_f", error, total_error) - ! Close the member datatype + ! Close the member datatype CALL h5tclose_f(mtid2,error) CALL check("h5tclose_f", error, total_error) - ! Close Compound Datatype + ! Close Compound Datatype CALL h5tclose_f(tid2,error) CALL check("h5tclose_f", error, total_error) - ! READ dataset from disk - + ! READ dataset from disk + f_ptr = c_null_ptr f_ptr = C_LOC(rdata(1,1)) CALL H5Dread_f(dataset, tid1, f_ptr, error) CALL check("H5Dread_f", error, total_error) - ! Compare data read in + ! Compare data read in DO i = 1, SPACE1_DIM1 DO j = 1, ARRAY1_DIM1 IF(wdata(i,j)%i.NE.rdata(i,j)%i)THEN @@ -616,21 +616,21 @@ END SUBROUTINE test_array_compound_atomic DO k = 1, ARRAY2_DIM1 CALL VERIFY("h5dread_f",wdata(i,j)%f(k),rdata(i,j)%f(k),total_error) IF(total_error.NE.0) PRINT*,'ERROR: Wrong real array data is read back by H5Dread_f' - CALL VERIFY("h5dread_f",wdata(i,j)%c(k),rdata(i,j)%c(k),total_error) + CALL VERIFY("h5dread_f",wdata(i,j)%c(k),rdata(i,j)%c(k),total_error) IF(total_error.NE.0) PRINT*,'ERROR: Wrong character array data is read back by H5Dread_f' ENDDO ENDDO ENDDO - ! Close Datatype + ! Close Datatype CALL h5tclose_f(tid1,error) CALL check("h5tclose_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_array_compound_array @@ -644,7 +644,7 @@ END SUBROUTINE test_array_compound_atomic !!$!*************************************************************** !!$ SUBROUTINE test_array_bkg(total_error) - + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error @@ -674,7 +674,7 @@ END SUBROUTINE test_array_compound_atomic TYPE(CmpField_struct), DIMENSION(1:LENGTH), TARGET :: cf TYPE(CmpField_struct), DIMENSION(1:LENGTH), TARGET :: cfr - + TYPE CmpDTSinfo_struct INTEGER :: nsubfields CHARACTER(LEN=5), DIMENSION(1:nmax) :: name @@ -687,9 +687,9 @@ END SUBROUTINE test_array_compound_atomic TYPE fld_t_struct REAL(KIND=sp), DIMENSION(1:ALEN) :: b END TYPE fld_t_struct - - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype INTEGER(SIZE_T) :: type_sized ! Size of the double datatype INTEGER(SIZE_T) :: sizeof_compound ! total size of compound @@ -698,14 +698,14 @@ END SUBROUTINE test_array_compound_atomic CHARACTER(LEN=10), PARAMETER :: FILENAME = "tarray3.h5" - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims1 ! Array dimensions for reading + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: rdims ! Array dimensions for reading INTEGER :: error TYPE(c_ptr) :: f_ptr - -! Initialize the data -! ------------------- + +! Initialize the data +! ------------------- DO i = 1, LENGTH DO j = 1, ALEN @@ -715,13 +715,13 @@ END SUBROUTINE test_array_compound_atomic ENDDO ENDDO - ! Set the number of data members - ! ------------------------------ + ! Set the number of data members + ! ------------------------------ dtsinfo%nsubfields = 3 - ! Initialize the offsets - ! ----------------------- + ! Initialize the offsets + ! ----------------------- CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error) CALL check("h5tget_size_f", error, total_error) IF(h5_sizeof(cf(1)%b(1)).EQ.4_size_t)THEN @@ -736,44 +736,44 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5tget_size_f", error, total_error) dtsinfo%offset(1) = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%a(1))) - dtsinfo%offset(2) = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%b(1))) + dtsinfo%offset(2) = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%b(1))) dtsinfo%offset(3) = H5OFFSETOF(C_LOC(cf(1)),C_LOC(cf(1)%c(1))) - ! Initialize the data type IDs - ! ---------------------------- + ! Initialize the data type IDs + ! ---------------------------- dtsinfo%datatype(1) = H5T_NATIVE_INTEGER; dtsinfo%datatype(2) = H5T_NATIVE_REAL_C_FLOAT; dtsinfo%datatype(3) = H5T_NATIVE_REAL_C_DOUBLE; - ! Initialize the names of data members - ! ------------------------------------ - + ! Initialize the names of data members + ! ------------------------------------ + dtsinfo%name(1) = "One " dtsinfo%name(2) = "Two " dtsinfo%name(3) = "Three" - - ! Create file - ! ----------- + + ! Create file + ! ----------- CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) - ! Create data space - ! ----------------- + ! Create data space + ! ----------------- CALL h5screate_simple_f(RANK, dim, space, error) CALL check("h5screate_simple_f", error, total_error) - ! Create the memory data type - ! --------------------------- + ! Create the memory data type + ! --------------------------- CALL h5tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(cf(1)), C_LOC(cf(2))), type, error) CALL check("h5tcreate_f", error, total_error) - ! Add members to the compound data type - ! -------------------------------------- + ! Add members to the compound data type + ! -------------------------------------- DO i = 1, dtsinfo%nsubfields CALL h5tarray_create_f(dtsinfo%datatype(i), ndims(i), dima, array_dt, error) @@ -785,13 +785,13 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5tclose_f", error, total_error) ENDDO - ! Create the dataset + ! Create the dataset ! ------------------ / CALL h5dcreate_f(fid,FIELDNAME,type, space, dataset,error) CALL check("h5dcreate_f", error, total_error) - ! Write data to the dataset - ! ------------------------- + ! Write data to the dataset + ! ------------------------- ALLOCATE(rdims(1:2)) ! dummy not needed @@ -806,8 +806,8 @@ END SUBROUTINE test_array_compound_atomic CALL H5Dread_f(dataset, type, f_ptr, error) CALL check("H5Dread_f", error, total_error) - ! Verify correct data - ! ------------------- + ! Verify correct data + ! ------------------- DO i = 1, LENGTH DO j = 1, ALEN IF( cf(i)%a(j) .NE. cfr(i)%a(j) )THEN @@ -820,8 +820,8 @@ END SUBROUTINE test_array_compound_atomic ENDDO - ! Release IDs - ! ----------- + ! Release IDs + ! ----------- CALL h5tclose_f(type,error) CALL check("h5tclose_f", error, total_error) CALL h5sclose_f(space,error) @@ -832,7 +832,7 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5fclose_f", error, total_error) !**************************** - ! Reopen the file and update + ! Reopen the file and update !**************************** CALL h5fopen_f (FILENAME, H5F_ACC_RDWR_F, fid, error) @@ -852,8 +852,8 @@ END SUBROUTINE test_array_compound_atomic CALL h5tinsert_f(TYPE, "Two", 0_size_t, array_dt, error) CALL check("h5tinsert_f", error, total_error) - ! Initialize the data to overwrite - ! -------------------------------- + ! Initialize the data to overwrite + ! -------------------------------- DO i = 1, LENGTH DO j = 1, ALEN fld(i)%b(j) = 1.313 @@ -867,8 +867,8 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5dwrite_f", error, total_error) - ! Read just the field changed - + ! Read just the field changed + f_ptr = C_LOC(fldr(1)) CALL H5Dread_f(dataset, TYPE, f_ptr, error) CALL check("H5Dread_f", error, total_error) @@ -887,15 +887,15 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5dget_type_f", error, total_error) - ! Read the entire dataset again + ! Read the entire dataset again f_ptr = C_LOC(cfr(1)) CALL H5Dread_f(dataset, TYPE, f_ptr, error) CALL check("H5Dread_f", error, total_error) - ! Verify correct data - ! ------------------- + ! Verify correct data + ! ------------------- DO i = 1, LENGTH DO j = 1, ALEN @@ -915,7 +915,7 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5fclose_f", error, total_error) !************************************************** -! Reopen the file and print out all the data again +! Reopen the file and print out all the data again !************************************************** CALL h5fopen_f (FILENAME, H5F_ACC_RDWR_F, fid, error) @@ -930,8 +930,8 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5dget_type_f", error, total_error) - ! Reset the data to read in - ! ------------------------- + ! Reset the data to read in + ! ------------------------- DO i = 1, LENGTH cfr(i)%a(:) = 0 @@ -943,8 +943,8 @@ END SUBROUTINE test_array_compound_atomic CALL H5Dread_f(dataset, TYPE, f_ptr, error) CALL check("H5Dread_f", error, total_error) - ! Verify correct data - ! ------------------- + ! Verify correct data + ! ------------------- DO i = 1, LENGTH DO j = 1, ALEN @@ -968,22 +968,22 @@ END SUBROUTINE test_array_compound_atomic SUBROUTINE test_h5kind_to_type(total_error) IMPLICIT NONE - + INTEGER, INTENT(INOUT) :: total_error - + INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors -#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 +#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors - INTEGER(int_kind_32), DIMENSION(1:4), TARGET :: dset_data_i32, data_out_i32 - INTEGER(HID_T) :: dset_id32 ! Dataset identifier - CHARACTER(LEN=6), PARAMETER :: dsetname16 = "dset16" ! Dataset name + INTEGER(int_kind_32), DIMENSION(1:4), TARGET :: dset_data_i32, data_out_i32 + INTEGER(HID_T) :: dset_id32 ! Dataset identifier + CHARACTER(LEN=6), PARAMETER :: dsetname16 = "dset16" ! Dataset name #endif INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE !should map to REAL*8 on most modern processors - + ! Check if C has quad precision extension #if H5_HAVE_FLOAT128!=0 ! Check if Fortran supports quad precision @@ -1004,8 +1004,8 @@ END SUBROUTINE test_array_compound_atomic INTEGER, PARAMETER :: real_kind_31 = SELECTED_REAL_KIND(15,307) # endif #endif - REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31 - INTEGER(HID_T) :: dset_idr16 ! Dataset identifier + REAL(real_kind_31), DIMENSION(1:4), TARGET :: dset_data_r31, data_out_r31 + INTEGER(HID_T) :: dset_idr16 ! Dataset identifier CHARACTER(LEN=7), PARAMETER :: dsetnamer16 = "dsetr16" ! Dataset name CHARACTER(LEN=12), PARAMETER :: filename = "dsetf_F03.h5" ! File name @@ -1016,19 +1016,19 @@ END SUBROUTINE test_array_compound_atomic CHARACTER(LEN=6), PARAMETER :: dsetnamer = "dsetr" ! Dataset name CHARACTER(LEN=6), PARAMETER :: dsetnamer4 = "dsetr4" ! Dataset name CHARACTER(LEN=6), PARAMETER :: dsetnamer8 = "dsetr8" ! Dataset name - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id1 ! Dataset identifier - INTEGER(HID_T) :: dset_id4 ! Dataset identifier - INTEGER(HID_T) :: dset_id8 ! Dataset identifier - INTEGER(HID_T) :: dset_id16 ! Dataset identifier - INTEGER(HID_T) :: dset_idr ! Dataset identifier - INTEGER(HID_T) :: dset_idr4 ! Dataset identifier - INTEGER(HID_T) :: dset_idr8 ! Dataset identifier - + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id1 ! Dataset identifier + INTEGER(HID_T) :: dset_id4 ! Dataset identifier + INTEGER(HID_T) :: dset_id8 ! Dataset identifier + INTEGER(HID_T) :: dset_id16 ! Dataset identifier + INTEGER(HID_T) :: dset_idr ! Dataset identifier + INTEGER(HID_T) :: dset_idr4 ! Dataset identifier + INTEGER(HID_T) :: dset_idr8 ! Dataset identifier + INTEGER :: error ! Error flag INTEGER :: i - + ! Data buffers: INTEGER(int_kind_1), DIMENSION(1:4), TARGET :: dset_data_i1, data_out_i1 @@ -1039,10 +1039,10 @@ END SUBROUTINE test_array_compound_atomic REAL, DIMENSION(1:4), TARGET :: dset_data_r, data_out_r REAL(real_kind_7), DIMENSION(1:4), TARGET :: dset_data_r7, data_out_r7 REAL(real_kind_15), DIMENSION(1:4), TARGET :: dset_data_r15, data_out_r15 - - INTEGER(HSIZE_T), DIMENSION(1:1) :: data_dims = (/4/) + + INTEGER(HSIZE_T), DIMENSION(1:1) :: data_dims = (/4/) INTEGER(HID_T) :: dspace_id ! Dataspace identifier - + TYPE(C_PTR) :: f_ptr ! @@ -1060,7 +1060,7 @@ END SUBROUTINE test_array_compound_atomic dset_data_r7(i) = 4.0_real_kind_7*ATAN(1.0_real_kind_7)-REAL(i-1,real_kind_7) dset_data_r15(i) = 4.0_real_kind_15*ATAN(1.0_real_kind_15)-REAL(i-1,real_kind_15) dset_data_r31(i) = 4.0_real_kind_31*ATAN(1.0_real_kind_31)-REAL(i-1,real_kind_31) - + END DO CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) @@ -1142,7 +1142,7 @@ END SUBROUTINE test_array_compound_atomic ! ! Read the dataset. ! - ! Read data back into an integer size that is larger then the original size used for + ! Read data back into an integer size that is larger then the original size used for ! writing the data f_ptr = C_LOC(data_out_i1(1)) CALL h5dread_f(dset_id1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND), f_ptr, error) @@ -1174,12 +1174,12 @@ END SUBROUTINE test_array_compound_atomic CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) DO i = 1, 4 - + CALL verify("h5kind_to_type",dset_data_i1(i),data_out_i1(i),total_error) CALL verify("h5kind_to_type",dset_data_i4(i),data_out_i4(i),total_error) CALL verify("h5kind_to_type",dset_data_i8(i),data_out_i8(i),total_error) CALL verify("h5kind_to_type",dset_data_i16(i),data_out_i16(i),total_error) - + #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 CALL verify("h5kind_to_type",dset_data_i32(i),data_out_i32(i),total_error) #endif @@ -1188,7 +1188,7 @@ END SUBROUTINE test_array_compound_atomic CALL verify("h5kind_to_type",dset_data_r15(i),data_out_r15(i),total_error) CALL verify("h5kind_to_type",dset_data_r31(i),data_out_r31(i),total_error) END DO - + ! ! Close the dataset. ! @@ -1224,7 +1224,7 @@ END SUBROUTINE test_h5kind_to_type SUBROUTINE t_array(total_error) IMPLICIT NONE - + INTEGER, INTENT(INOUT) :: total_error CHARACTER(LEN=19), PARAMETER :: filename = "t_array_F03.h5" @@ -1236,7 +1236,7 @@ SUBROUTINE t_array(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: adims = (/adim0, adim1/) INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims - INTEGER, DIMENSION(1:dim0, 1:adim0, 1:adim1), TARGET :: wdata ! Write buffer + INTEGER, DIMENSION(1:dim0, 1:adim0, 1:adim1), TARGET :: wdata ! Write buffer INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer INTEGER :: i, j, k TYPE(C_PTR) :: f_ptr @@ -1292,7 +1292,7 @@ SUBROUTINE t_array(total_error) CALL H5Fclose_f(file, error) CALL check("h5fclose_f",error, total_error) ! - ! Now we begin the read section of this example. + ! Now we begin the read section of this example. ! ! Open file, dataset, and attribute. ! @@ -1322,7 +1322,7 @@ SUBROUTINE t_array(total_error) ALLOCATE(rdata(1:dims(1),1:adims(1),1:adims(2))) ! ! Create the memory datatype. - ! + ! CALL H5Tarray_create_f(H5T_NATIVE_INTEGER, 2, adims, memtype, error) CALL check("H5Tarray_create_f",error, total_error) ! @@ -1397,7 +1397,7 @@ SUBROUTINE t_enum(total_error) F_BASET = H5T_STD_I16BE ! File base type M_BASET = H5T_NATIVE_INTEGER ! Memory base type DO i = 1, dim0 - DO j = 1, dim1 + DO j = 1, dim1 wdata(i,j) = MOD( (j-1)*(i-1), PLASMA+1) ENDDO ENDDO @@ -1413,7 +1413,7 @@ SUBROUTINE t_enum(total_error) ! CALL h5tenum_create_f(F_BASET, filetype, error) CALL check("h5tenum_create_f",error, total_error) - + CALL h5tenum_create_f(M_BASET, memtype, error) CALL check("h5tenum_create_f",error, total_error) @@ -1446,7 +1446,7 @@ SUBROUTINE t_enum(total_error) CALL check("h5screate_simple_f",error, total_error) ! ! Create the dataset and write the enumerated data to it. - ! + ! CALL h5dcreate_f(file, dataset, filetype, space, dset, error) CALL check("h5dcreate_f",error, total_error) f_ptr = C_LOC(wdata(1,1)) @@ -1521,7 +1521,7 @@ SUBROUTINE t_enum(total_error) CALL check("h5tclose_f",error, total_error) CALL h5fclose_f(file , error) CALL check("h5fclose_f",error, total_error) - + END SUBROUTINE t_enum SUBROUTINE t_bit(total_error) @@ -1538,7 +1538,7 @@ SUBROUTINE t_bit(total_error) INTEGER(HID_T) :: file, space, dset ! Handles INTEGER(HSIZE_T), DIMENSION(1:2) :: dims = (/dim0, dim1/) INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims - INTEGER(C_SIGNED_CHAR), DIMENSION(1:dim0, 1:dim1), TARGET :: wdata ! Write buffer + INTEGER(C_SIGNED_CHAR), DIMENSION(1:dim0, 1:dim1), TARGET :: wdata ! Write buffer INTEGER(C_SIGNED_CHAR), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer INTEGER :: A, B, C, D INTEGER :: Aw, Bw, Cw, Dw @@ -1587,7 +1587,7 @@ SUBROUTINE t_bit(total_error) CALL H5Fclose_f(file, error) CALL check("h5fclose_f",error, total_error) ! - ! Now we begin the read section of this example. + ! Now we begin the read section of this example. ! ! Open file, dataset. ! @@ -1620,8 +1620,8 @@ SUBROUTINE t_bit(total_error) B = IAND(ISHFT(rdata(i,j),-2), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "B" C = IAND(ISHFT(rdata(i,j),-4), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "C" D = IAND(ISHFT(rdata(i,j),-6), INT(hex,C_SIGNED_CHAR)) ! Retrieve field "D" - - Aw = IAND(wdata(i,j), INT(hex,C_SIGNED_CHAR)) + + Aw = IAND(wdata(i,j), INT(hex,C_SIGNED_CHAR)) Bw = IAND(ISHFT(wdata(i,j),-2), INT(hex,C_SIGNED_CHAR)) Cw = IAND(ISHFT(wdata(i,j),-4), INT(hex,C_SIGNED_CHAR)) Dw = IAND(ISHFT(wdata(i,j),-6), INT(hex,C_SIGNED_CHAR)) @@ -1662,8 +1662,8 @@ SUBROUTINE t_opaque(total_error) CHARACTER(LEN=size), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer CHARACTER(LEN=size), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer CHARACTER(LEN=size-1) :: str = "OPAQUE" - - CHARACTER(LEN=14) :: tag_sm ! Test reading obaque tag into + + CHARACTER(LEN=14) :: tag_sm ! Test reading obaque tag into CHARACTER(LEN=15) :: tag_exact ! buffers that are: to small, exact CHARACTER(LEN=17) :: tag_big ! and to big. @@ -1677,7 +1677,7 @@ SUBROUTINE t_opaque(total_error) ! Initialize data. ! DO i = 1, dim0 - WRITE(ichr,'(I1)') i-1 + WRITE(ichr,'(I1)') i-1 wdata(i) = str//ichr ENDDO ! @@ -1735,15 +1735,15 @@ SUBROUTINE t_opaque(total_error) CALL h5tget_size_f(dtype, len, error) CALL check("h5tget_size_f",error, total_error) - ! Next tests should return + ! Next tests should return ! opaque_tag = tag = "Character array" and the actual length = 15 - + ! Test reading into a string that is to small CALL h5tget_tag_f(dtype, tag_sm, taglen, error) CALL check("h5tget_tag_f",error, total_error) CALL VERIFY("h5tget_tag_f", taglen, 15, total_error) CALL verify("h5tget_tag_f",tag_sm,"Character arra", total_error) - + ! Test reading into a string that is exact CALL h5tget_tag_f(dtype, tag_exact, taglen, error) CALL check("h5tget_tag_f",error, total_error) @@ -1755,7 +1755,7 @@ SUBROUTINE t_opaque(total_error) CALL check("h5tget_tag_f",error, total_error) CALL VERIFY("h5tget_tag_f", taglen, 15, total_error) CALL verify("h5tget_tag_f",tag_big,"Character array ", total_error) - + ! ! Get dataspace and allocate memory for read buffer. ! @@ -1787,7 +1787,7 @@ SUBROUTINE t_opaque(total_error) CALL check("h5tclose_f",error, total_error) CALL H5Fclose_f(file, error) CALL check("h5fclose_f",error, total_error) - + END SUBROUTINE t_opaque SUBROUTINE t_objref(total_error) @@ -1855,7 +1855,7 @@ SUBROUTINE t_objref(total_error) ! CALL h5dcreate_f(file, dataset, H5T_STD_REF_OBJ, space, dset, error) CALL check("h5dcreate_f",error, total_error) - + f_ptr = C_LOC(wdata(1)) CALL h5dwrite_f(dset, H5T_STD_REF_OBJ, f_ptr, error) CALL check("h5dwrite_f",error, total_error) @@ -1955,11 +1955,11 @@ SUBROUTINE t_regref(total_error) INTEGER :: error INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) - INTEGER(HSIZE_T), DIMENSION(1:1) :: dims3 + INTEGER(HSIZE_T), DIMENSION(1:1) :: dims3 INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2 = (/ds2dim0,ds2dim1/) INTEGER(HSIZE_T), DIMENSION(1:2,1:4) :: coords = RESHAPE((/2,1,12,3,1,2,5,3/),(/2,4/)) - + INTEGER(HSIZE_T), DIMENSION(1:2) :: start=(/0,0/),stride=(/11,2/),count=(/2,2/), BLOCK=(/3,1/) INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims @@ -2077,7 +2077,7 @@ SUBROUTINE t_regref(total_error) ! Output the data to the screen. ! DO i = 1, dims(1) - + ! ! Open the referenced object, retrieve its region as a ! dataspace selection. @@ -2085,10 +2085,10 @@ SUBROUTINE t_regref(total_error) f_ptr = C_LOC(rdata(i)) CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error) CALL check("H5Rdereference_f",error, total_error) - + CALL H5Rget_region_f(dset, f_ptr, space, error) CALL check("H5Rget_region_f",error, total_error) - + ! ! Get the object's name ! @@ -2103,7 +2103,7 @@ SUBROUTINE t_regref(total_error) CALL H5Sget_select_npoints_f(space, npoints, error) CALL check("H5Sget_select_npoints_f",error, total_error) CALL VERIFY("H5Sget_select_npoints_f", INT(npoints), LEN_TRIM(chrref_correct(i)), total_error) - + dims3(1) = npoints ! ! Read the dataset region. @@ -2162,9 +2162,9 @@ SUBROUTINE t_vlen(total_error) TYPE(hvl_t), DIMENSION(1:2), TARGET :: rdata ! Pointer to vlen structures INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/2/) - INTEGER, DIMENSION(:), POINTER :: ptr_r + INTEGER, DIMENSION(:), POINTER :: ptr_r TYPE(C_PTR) :: f_ptr - + ! ! Initialize variable-length data. wdata(1) is a countdown of ! length LEN0, wdata(2) is a Fibonacci sequence of length LEN1. @@ -2209,7 +2209,7 @@ SUBROUTINE t_vlen(total_error) ! CALL H5Dcreate_f(file, dataset, filetype, space, dset, error) CALL check("h5dcreate_f",error, total_error) - + f_ptr = C_LOC(wdata(1)) CALL h5dwrite_f(dset, memtype, f_ptr, error) CALL check("h5dwrite_f",error, total_error) @@ -2249,14 +2249,14 @@ SUBROUTINE t_vlen(total_error) CALL H5Dget_space_f(dset, space, error) CALL check("H5Dget_space_f",error, total_error) dim0 = dims(1) - CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) + CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) CALL check("H5Sget_simple_extent_dims_f",error, total_error) CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), INT(dim0), total_error) ! ! Create the memory datatype. ! - CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, memtype, error) + CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, memtype, error) CALL check("H5Tvlen_create_f",error, total_error) ! @@ -2304,7 +2304,7 @@ SUBROUTINE t_vlstring(total_error) INTEGER :: error INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims - + CHARACTER(LEN=sdim), DIMENSION(1:dim0), TARGET :: & wdata = (/"Parting", "is such", "sweet ", "sorrow."/) ! Write buffer CHARACTER(LEN=sdim), DIMENSION(:), ALLOCATABLE :: rdata ! Read buffer @@ -2373,7 +2373,7 @@ SUBROUTINE t_vlstring(total_error) ! CALL H5Dget_space_f(dset, space, error) CALL check("H5Dget_space_f",error, total_error) - CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) + CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) CALL check("H5Sget_simple_extent_dims_f",error, total_error) CALL VERIFY("H5Sget_simple_extent_dims_f", INT(dims(1)), INT(dim0), total_error) @@ -2422,7 +2422,7 @@ SUBROUTINE t_vlstring_readwrite(total_error) INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2D = (/dim1,dim0/) INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims - + TYPE(C_PTR), DIMENSION(1:dim0), TARGET :: wdata CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A = "123456"//C_NULL_CHAR CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: B = "7890"//C_NULL_CHAR @@ -2430,7 +2430,7 @@ SUBROUTINE t_vlstring_readwrite(total_error) CHARACTER(len=3, KIND=c_char), DIMENSION(1:1), TARGET :: D = "df"//C_NULL_CHAR TYPE(C_PTR), DIMENSION(1:dim1,1:dim0), TARGET :: wdata2D - + CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A11 = "A(1,1)"//C_NULL_CHAR CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: A12 = "A12"//C_NULL_CHAR CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: A13 = "A_13"//C_NULL_CHAR @@ -2566,13 +2566,13 @@ SUBROUTINE t_vlstring_readwrite(total_error) CALL H5Dget_space_f(dset, space, error) CALL check("H5Dget_space_f",error, total_error) - CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) + CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) CALL check("H5Sget_simple_extent_dims_f",error, total_error) ALLOCATE(rdata(1:dims(1))) ! ! Read the data. ! - + f_ptr = C_LOC(rdata(1)) CALL h5dread_f(dset, H5T_STRING, f_ptr, error) CALL check("H5Dread_f",error, total_error) @@ -2612,14 +2612,14 @@ SUBROUTINE t_vlstring_readwrite(total_error) CALL check("H5Dget_space_f",error, total_error) - CALL H5Sget_simple_extent_dims_f(space, dims2D, maxdims, error) + CALL H5Sget_simple_extent_dims_f(space, dims2D, maxdims, error) CALL check("H5Sget_simple_extent_dims_f",error, total_error) ALLOCATE(rdata2D(1:dims2D(1),1:dims2D(2))) ! ! Read the data. ! - + f_ptr = C_LOC(rdata2D(1,1)) CALL h5dread_f(dset, H5T_STRING, f_ptr, error) CALL check("H5Dread_f",error, total_error) @@ -2736,7 +2736,7 @@ SUBROUTINE t_string(total_error) ! CALL H5Dget_space_f(dset, space, error) CALL check("H5Dget_space_f",error, total_error) - CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) + CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error) CALL check("H5Sget_simple_extent_dims_f",error, total_error) CALL VERIFY("H5Sget_simple_extent_dims_f", dims(1), INT(dim0,hsize_t), total_error) @@ -2744,9 +2744,9 @@ SUBROUTINE t_string(total_error) ! ! Create the memory datatype. ! - CALL H5Tcopy_f(H5T_FORTRAN_S1, memtype, error) + CALL H5Tcopy_f(H5T_FORTRAN_S1, memtype, error) CALL check("H5Tcopy_f",error, total_error) - CALL H5Tset_size_f(memtype, sdim, error) + CALL H5Tset_size_f(memtype, sdim, error) CALL check("H5Tset_size_f",error, total_error) ! ! Read the data. @@ -2777,9 +2777,9 @@ SUBROUTINE t_string(total_error) END SUBROUTINE t_string SUBROUTINE vl_test_special_char(total_error) - + IMPLICIT NONE - + ! INTERFACE ! SUBROUTINE setup_buffer(data_in, line_lengths, char_type) ! USE HDF5 @@ -2790,9 +2790,9 @@ SUBROUTINE vl_test_special_char(total_error) ! CHARACTER(KIND=C_CHAR,LEN=*) :: char_type ! END SUBROUTINE setup_buffer ! END INTERFACE - + INTEGER, INTENT(OUT) :: total_error - + CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5" INTEGER, PARAMETER :: line_length = 10 INTEGER(hid_t) :: file @@ -2815,7 +2815,7 @@ SUBROUTINE vl_test_special_char(total_error) ! CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error) CALL check("h5fcreate_f",error, total_error) - + max_dims = (/H5S_UNLIMITED_F/) ! @@ -2835,7 +2835,7 @@ SUBROUTINE vl_test_special_char(total_error) CALL check("h5pcreate_f", error, total_error) CALL h5pset_chunk_f(dcpl, 1, chunk, error) CALL check("h5pset_chunk_f", error, total_error) - + data_dims(1) = line_length data_dims(2) = n ! @@ -2855,7 +2855,7 @@ SUBROUTINE vl_test_special_char(total_error) ! CALL h5dread_vl_f(dataset0, string_id, data_out(1:n), data_dims, line_lengths(1:n), error, space) CALL check("h5dread_vl_f", error, total_error) - + DO j = 1, n IF(data_in(j).NE.data_out(j))THEN total_error = total_error + 1 @@ -2873,17 +2873,17 @@ SUBROUTINE vl_test_special_char(total_error) CALL check("h5sclose_f", error, total_error) CALL h5fclose_f(file, error) CALL check("h5fclose_f", error, total_error) - + END SUBROUTINE vl_test_special_char SUBROUTINE setup_buffer(data_in, line_lengths, char_type) - + IMPLICIT NONE - + ! Creates a simple "Data_in" consisting of the letters of the alphabet, ! one per line, with a control character. - + CHARACTER(len=10), DIMENSION(:) :: data_in INTEGER(size_t), DIMENSION(:) :: line_lengths CHARACTER(LEN=3) :: lets = 'abc' @@ -2904,7 +2904,7 @@ SUBROUTINE setup_buffer(data_in, line_lengths, char_type) END DO data_in(n:n) = char_type(1:1) line_lengths(n) = 1 - + END SUBROUTINE setup_buffer !------------------------------------------------------------------------- @@ -2919,9 +2919,9 @@ END SUBROUTINE setup_buffer ! Decemeber 7, 2010 ! ! Modifications: Moved this subroutine from the 1.8 test file and -! modified it to use F2003 features. -! This routine requires 4 byte reals, so we use F2003 features to -! ensure the requirement is satisfied in a portable way. +! modified it to use F2003 features. +! This routine requires 4 byte reals, so we use F2003 features to +! ensure the requirement is satisfied in a portable way. ! The need for this arises when a user specifies the default real is 8 bytes. ! MSB 7/31/12 ! @@ -2934,7 +2934,7 @@ SUBROUTINE test_nbit(total_error ) INTEGER, PARAMETER :: wp = C_FLOAT !should map to REAL*4 on most modern processors INTEGER, INTENT(INOUT) :: total_error INTEGER(hid_t) :: file - + INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/) INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/) @@ -2972,14 +2972,14 @@ SUBROUTINE test_nbit(total_error ) PRECISION = 20 CALL H5Tset_precision_f(datatype,PRECISION, error) CALL CHECK(" H5Tset_precision_f", error, total_error) - + CALL H5Tset_size_f(datatype, 4_size_t, error) CALL CHECK(" H5Tset_size_f", error, total_error) - + CALL H5Tset_ebias_f(datatype, 31_size_t, error) CALL CHECK(" H5Tset_ebias_f", error, total_error) - - ! Create the data space + + ! Create the data space CALL H5Screate_simple_f(2, dims, space, error) CALL CHECK(" H5Screate_simple_f", error, total_error) @@ -3011,7 +3011,7 @@ SUBROUTINE test_nbit(total_error ) !---------------------------------------------------------------------- ! STEP 2: Try to read the data we just wrote. !---------------------------------------------------------------------- - ! + ! f_ptr = C_LOC(new_data(1,1)) CALL H5Dread_f(dataset, mem_type_id, f_ptr, error) CALL CHECK(" H5Dread_f", error, total_error) @@ -3021,7 +3021,7 @@ SUBROUTINE test_nbit(total_error ) ! i_loop: DO i = 1, dims(1) j_loop: DO j = 1, dims(2) - + IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN IF( .NOT.check_real_eq( new_data(i,j), orig_data(i,j)) ) THEN @@ -3079,7 +3079,7 @@ SUBROUTINE t_enum_conv(total_error) INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors - + INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1 ! Handles @@ -3092,7 +3092,7 @@ SUBROUTINE t_enum_conv(total_error) INTEGER(KIND(E1_RED)), TARGET :: val - ! Enumerated data array + ! Enumerated data array ! Some values are out of range for testing. The library should accept them INTEGER(KIND(E1_RED)), DIMENSION(1:20), TARGET :: data1 = (/INT(E1_RED,KIND(E1_RED)), & INT(E1_GREEN,KIND(E1_RED)), INT(E1_BLUE,KIND(E1_RED)), & @@ -3140,7 +3140,7 @@ SUBROUTINE t_enum_conv(total_error) ! ! Initialize enum data. ! - + val = E1_RED CALL H5Tenum_insert_f(dtype, "RED", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) @@ -3208,7 +3208,7 @@ SUBROUTINE t_enum_conv(total_error) ENDIF ENDDO - ! Test converting the data to (KIND=C_double) number. + ! Test converting the data to (KIND=C_double) number. ! Read enum data back as (KIND=C_double) number m_baset = h5kind_to_type(KIND(data_double(1)), H5_REAL_KIND) ! Memory base type @@ -3225,7 +3225,7 @@ SUBROUTINE t_enum_conv(total_error) ENDIF ENDDO - ! Test converting the data to (SELECTED_INT_KIND(9)) number. + ! Test converting the data to (SELECTED_INT_KIND(9)) number. ! Read enum data back as (SELECTED_INT_KIND(9)) number m_baset = h5kind_to_type(int_kind_8, H5_INTEGER_KIND) ! Memory base type @@ -3242,7 +3242,7 @@ SUBROUTINE t_enum_conv(total_error) ENDIF ENDDO - ! Test converting the data to (SELECTED_INT_KIND(18)) number. + ! Test converting the data to (SELECTED_INT_KIND(18)) number. ! Read enum data back as (SELECTED_INT_KIND(18)) number m_baset = h5kind_to_type(int_kind_16, H5_INTEGER_KIND) ! Memory base type @@ -3259,7 +3259,7 @@ SUBROUTINE t_enum_conv(total_error) ENDIF ENDDO - ! Test converting the data to C_FLOAT number. + ! Test converting the data to C_FLOAT number. ! Read enum data back as C_FLOAT number m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type @@ -3287,13 +3287,13 @@ SUBROUTINE t_enum_conv(total_error) m_baset = h5kind_to_type(KIND(data_int(1)), H5_INTEGER_KIND) ! Memory base type CALL h5dcreate_f(cwg, "color_table2", m_baset, space, dset, error) CALL check("h5dcreate_f", error, total_error) - + ! Write the enum data f_ptr = C_LOC(data1(1)) CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space) CALL check("h5dwrite_f", error, total_error) - ! Test reading back the data with no conversion + ! Test reading back the data with no conversion f_ptr = C_LOC(data_int(1)) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) @@ -3321,7 +3321,7 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space) CALL check("h5dwrite_f", error, total_error) - ! Test reading back the data with no conversion + ! Test reading back the data with no conversion f_ptr = C_LOC(data_double(1)) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) @@ -3349,7 +3349,7 @@ SUBROUTINE t_enum_conv(total_error) CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space) CALL check("h5dwrite_f", error, total_error) - ! Test reading back the data with no conversion + ! Test reading back the data with no conversion f_ptr = C_LOC(data_r7(1)) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) @@ -3372,13 +3372,13 @@ SUBROUTINE t_enum_conv(total_error) m_baset = h5kind_to_type(KIND(data_i16(1)), H5_INTEGER_KIND) ! Memory base type CALL h5dcreate_f(cwg, "color_table5", m_baset, space, dset, error) CALL check("h5dcreate_f", error, total_error) - + ! Write the enum data f_ptr = C_LOC(data1(1)) CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space) CALL check("h5dwrite_f", error, total_error) - ! Test reading back the data with no conversion + ! Test reading back the data with no conversion f_ptr = C_LOC(data_i16(1)) CALL h5dread_f(dset, m_baset, f_ptr, error, space, space) CALL check("h5dread_f", error, total_error) diff --git a/fortran/test/tH5VL.F90 b/fortran/test/tH5VL.F90 index 7ef9c19..18909e1 100644 --- a/fortran/test/tH5VL.F90 +++ b/fortran/test/tH5VL.F90 @@ -21,7 +21,7 @@ ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! CONTAINS SUBROUTINES -! vl_test_integer, vl_test_real, vl_test_string +! vl_test_integer, vl_test_real, vl_test_string ! !***** @@ -119,7 +119,7 @@ CONTAINS - ! + ! ! End access to the dataset and release resources used by it. ! CALL h5dclose_f(dset_id, error) diff --git a/fortran/test/tHDF5_F03.F90 b/fortran/test/tHDF5_F03.F90 index 96959d8..46e889b 100644 --- a/fortran/test/tHDF5_F03.F90 +++ b/fortran/test/tHDF5_F03.F90 @@ -7,7 +7,7 @@ ! src/fortran/test/tHDF5_F03.f90 ! ! PURPOSE -! This is the test module used for testing the Fortran2003 HDF +! This is the test module used for testing the Fortran2003 HDF ! library APIS. ! ! COPYRIGHT diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90 index 4df53bd..00e8966 100644 --- a/fortran/test/tf.F90 +++ b/fortran/test/tf.F90 @@ -79,7 +79,7 @@ CONTAINS CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--' - + error_string = failure IF (test_result == 0) THEN @@ -167,7 +167,7 @@ CONTAINS full_namelen = LEN(full_name) hdferr = h5_fixname_c(base_name, base_namelen, fapl, & full_name, full_namelen) - + END SUBROUTINE h5_fixname_f !---------------------------------------------------------------------- @@ -200,7 +200,7 @@ CONTAINS CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string INTERFACE @@ -215,10 +215,10 @@ CONTAINS INTEGER(HID_T), INTENT(IN) :: fapl END FUNCTION h5_cleanup_c END INTERFACE - + base_namelen = LEN(base_name) hdferr = h5_cleanup_c(base_name, base_namelen, fapl) - + END SUBROUTINE h5_cleanup_f !---------------------------------------------------------------------- @@ -258,7 +258,7 @@ CONTAINS INTEGER, INTENT(IN) :: status END SUBROUTINE h5_exit_c END INTERFACE - + CALL h5_exit_c(status) END SUBROUTINE h5_exit_f @@ -287,7 +287,7 @@ CONTAINS IMPLICIT NONE LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code INTEGER :: status - + INTERFACE SUBROUTINE h5_env_nocleanup_c(status) !DEC$ IF DEFINED(HDF5F90_WINDOWS) @@ -296,12 +296,12 @@ CONTAINS INTEGER :: status END SUBROUTINE h5_env_nocleanup_c END INTERFACE - + CALL h5_env_nocleanup_c(status) - + HDF5_NOCLEANUP = .FALSE. IF(status.EQ.1) HDF5_NOCLEANUP = .TRUE. - + END SUBROUTINE h5_env_nocleanup_f ! --------------------------------------------------------------------------------------------------- @@ -310,11 +310,11 @@ CONTAINS ! NOTES ! (1) The Sun/Oracle compiler has the following restrictions on the SIZEOF intrinsic function: ! -! "The SIZEOF intrinsic cannot be applied to arrays of an assumed size, characters of a -! length that is passed, or subroutine calls or names. SIZEOF returns default INTEGER*4 data. -! If compiling for a 64-bit environment, the compiler will issue a warning if the result overflows -! the INTEGER*4 data range. To use SIZEOF in a 64-bit environment with arrays larger -! than the INTEGER*4 limit (2 Gbytes), the SIZEOF function and +! "The SIZEOF intrinsic cannot be applied to arrays of an assumed size, characters of a +! length that is passed, or subroutine calls or names. SIZEOF returns default INTEGER*4 data. +! If compiling for a 64-bit environment, the compiler will issue a warning if the result overflows +! the INTEGER*4 data range. To use SIZEOF in a 64-bit environment with arrays larger +! than the INTEGER*4 limit (2 Gbytes), the SIZEOF function and ! the variables receiving the result must be declared INTEGER*8." ! ! Thus, we can not overload the H5_SIZEOF function to handle arrays (as used in tH5P_F03.f90), or diff --git a/fortran/test/vol_connector.F90 b/fortran/test/vol_connector.F90 new file mode 100644 index 0000000..bc4974f --- /dev/null +++ b/fortran/test/vol_connector.F90 @@ -0,0 +1,284 @@ +!****h* root/fortran/test/vol_connector.F90 +! +! NAME +! vol_connector.F90 +! +! FUNCTION +! +! Tests basic Fortran VOL plugin operations (registration, etc.). +! Uses the null VOL connector (built with the testing code) +! which is loaded as a dynamic plugin. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the COPYING file, which can be found at the root of the source code * +! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * +! If you do not have access to either file, you may request a copy from * +! help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +!***** + +MODULE VOL_TMOD + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + IMPLICIT NONE + + INTEGER, PARAMETER :: NATIVE_VOL_CONNECTOR_VALUE = 0 + CHARACTER(LEN=180) :: NATIVE_VOL_CONNECTOR_NAME + +CONTAINS + + !------------------------------------------------------------------------- + ! Function: test_registration_by_name() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by name. + ! + !------------------------------------------------------------------------- + ! + + SUBROUTINE test_registration_by_name(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0, vol_id_out = 1 + CHARACTER(LEN=64) :: name + CHARACTER(LEN=1) :: name_null + INTEGER(SIZE_T) :: name_len + INTEGER(hid_t) :: file_id + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_by_name_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .FALSE., total_error) + + ! Register the connector by name + CALL H5VLregister_connector_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id, error) + CALL check("H5VLregister_connector_by_name_f",error,total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_by_name_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .TRUE., total_error) + + CALL H5VLget_connector_id_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id_out, error) + CALL check("H5VLget_connector_id_by_name_f",error,total_error) + + CALL H5Fcreate_f("voltest.h5",H5F_ACC_TRUNC_F, file_id, error) + CALL check("H5F_create_f",error,total_error) + + CALL H5VLget_connector_name_f(file_id, name, error, name_len) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", INT(name_len), LEN_TRIM(NATIVE_VOL_CONNECTOR_NAME), total_error) + + CALL H5VLget_connector_name_f(file_id, name, error) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", TRIM(name), NATIVE_VOL_CONNECTOR_NAME, total_error) + + CALL H5VLget_connector_name_f(file_id, name_null, error, name_len) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", INT(name_len), LEN_TRIM(NATIVE_VOL_CONNECTOR_NAME), total_error) + + CALL H5VLget_connector_name_f(file_id, name_null, error) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", name_null, NATIVE_VOL_CONNECTOR_NAME(1:1), total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f",error,total_error) + + CALL H5VLclose_f(vol_id_out, error) + CALL check("H5VLclose_f",error, total_error) + + END SUBROUTINE test_registration_by_name + + !------------------------------------------------------------------------- + ! Function: test_registration_by_value() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by value. + ! + !------------------------------------------------------------------------- + + SUBROUTINE test_registration_by_value(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0 + + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_by_name_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .FALSE., total_error) + + ! Register the connector by value + CALL H5VLregister_connector_by_value_f(NATIVE_VOL_CONNECTOR_VALUE, vol_id, error) + CALL check("H5VLregister_connector_by_value_f", error, total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_by_name_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .TRUE., total_error) + + END SUBROUTINE test_registration_by_value + + + !------------------------------------------------------------------------- + ! Function: test_registration_by_name() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by name. + ! + !------------------------------------------------------------------------- + ! + + SUBROUTINE test_registration_by_fapl(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0, vol_id_out = 1 + INTEGER(hid_t) :: file_id + INTEGER(hid_t) :: fapl_id + TYPE(C_PTR) :: f_ptr + + CALL H5VLis_connector_registered_by_name_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .FALSE., total_error) + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_by_name_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .FALSE., total_error) + + CALL H5VLregister_connector_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id, error) + CALL check("H5VLregister_connector_by_name_f",error,total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_by_name_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_by_name_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_by_name_f", is_registered, .TRUE., total_error) + + ! Register the connector + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl_id, error) + CALL check("H5Pcreate_f",error,total_error) + + IF(TRIM(NATIVE_VOL_CONNECTOR_NAME) .EQ. "native")THEN + CALL H5Pset_vol_f(fapl_id, vol_id, error) + CALL check("H5Pset_vol_f",error,total_error) + + CALL H5Pget_vol_id_f(fapl_id, vol_id_out, error) + CALL check("H5Pget_vol_id_f",error,total_error) + CALL VERIFY("H5Pget_vol_id_f", vol_id_out, vol_id, total_error) + + f_ptr = C_NULL_PTR + CALL H5Pset_vol_f(fapl_id, vol_id, error, f_ptr) + CALL check("H5Pset_vol_f",error,total_error) + + CALL H5Pget_vol_id_f(fapl_id, vol_id_out, error) + CALL check("H5Pget_vol_id_f",error,total_error) + CALL VERIFY("H5Pget_vol_id_f", vol_id_out, vol_id, total_error) + ENDIF + + CALL H5VLget_connector_id_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id_out, error) + CALL check("H5VLget_connector_id_by_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_id_by_name_f", vol_id_out, vol_id, total_error) + CALL H5Fcreate_f("voltest.h5",H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) + + CALL check("H5F_create_f",error,total_error) + + CALL H5VLclose_f(vol_id_out, error) + CALL check("H5VLclose_f",error, total_error) + + CALL H5VLclose_f(vol_id, error) + CALL check("H5VLclose_f",error, total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f",error,total_error) + + CALL H5Pclose_f(fapl_id, error) + CALL check("H5Pclose_f",error,total_error) + + END SUBROUTINE test_registration_by_fapl + + +END MODULE VOL_TMOD + + +PROGRAM vol_connector + + USE HDF5 + USE VOL_TMOD + + IMPLICIT NONE + INTEGER :: total_error = 0 + INTEGER :: error + INTEGER :: ret_total_error + LOGICAL :: cleanup, status + CHARACTER(LEN=12) :: VOL_CONNECTOR_ENV + INTEGER :: LEN = 0 + + CALL h5open_f(error) + cleanup = .TRUE. + CALL h5_env_nocleanup_f(status) + IF(status) cleanup=.FALSE. + + WRITE(*,'(18X,A)') '==============================' + WRITE(*,'(24X,A)') 'FORTRAN VOL tests' + WRITE(*,'(18X,A)') '==============================' + + WRITE(*,'(A)') "Testing VOL connector plugin functionality." + + ! Check to see if the VOL connector was set with an env variable + CALL GET_ENVIRONMENT_VARIABLE("HDF5_VOL_CONNECTOR", VOL_CONNECTOR_ENV, LEN) + IF(LEN.NE.0)THEN + NATIVE_VOL_CONNECTOR_NAME = TRIM(VOL_CONNECTOR_ENV) + ELSE + NATIVE_VOL_CONNECTOR_NAME = "native" + ENDIF + + ret_total_error = 0 + CALL test_registration_by_name(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by name', total_error) + + ret_total_error = 0 + CALL test_registration_by_value(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by value', total_error) + + ret_total_error = 0 + CALL test_registration_by_fapl(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by fapl', total_error) + + WRITE(*, fmt = '(/18X,A)') '============================================' + WRITE(*, fmt = '(19X, A)', advance='NO') ' FORTRAN VOL tests completed with ' + WRITE(*, fmt = '(I4)', advance='NO') total_error + WRITE(*, fmt = '(A)' ) ' error(s) ! ' + WRITE(*,'(18X,A)') '============================================' + + CALL h5close_f(error) + + ! if errors detected, exit with non-zero code. + IF (total_error .NE. 0) CALL h5_exit_f(1) + +END PROGRAM vol_connector diff --git a/fortran/testpar/CMakeLists.txt b/fortran/testpar/CMakeLists.txt index 909cbaf..12489528 100644 --- a/fortran/testpar/CMakeLists.txt +++ b/fortran/testpar/CMakeLists.txt @@ -1,10 +1,15 @@ -cmake_minimum_required (VERSION 3.2.2) -PROJECT (HDF5_FORTRAN_TESTPAR C CXX Fortran) +cmake_minimum_required (VERSION 3.12) +project (HDF5_FORTRAN_TESTPAR C Fortran) #----------------------------------------------------------------------------- # Setup include Directories #----------------------------------------------------------------------------- -INCLUDE_DIRECTORIES (${MPI_Fortran_INCLUDE_PATH} ${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src) +set (TESTPAR_INCLUDES ${MPI_Fortran_INCLUDE_DIRS} ${HDF5_F90_BINARY_DIR} ${HDF5_F90_SRC_DIR}/src)) +if (NOT BUILD_SHARED_LIBS) + set (TESTPAR_INCLUDES ${TESTPAR_INCLUDES} ${CMAKE_Fortran_MODULE_DIRECTORY}/static) +else () + set (TESTPAR_INCLUDES ${TESTPAR_INCLUDES} ${CMAKE_Fortran_MODULE_DIRECTORY}/shared) +endif () #----------------------------------------------------------------------------- # Add Tests @@ -16,19 +21,44 @@ add_executable (parallel_test hyper.f90 mdset.f90 ) -TARGET_NAMING (parallel_test STATIC) -TARGET_FORTRAN_PROPERTIES (parallel_test STATIC " " " ") -target_link_libraries (parallel_test - ${HDF5_F90_TEST_LIB_TARGET} - ${HDF5_F90_LIB_TARGET} - ${HDF5_LIB_TARGET} - ${LINK_Fortran_LIBS} +target_include_directories (parallel_test + PRIVATE ${TESTPAR_INCLUDES} +) +target_compile_options(parallel_test + PRIVATE + "${HDF5_CMAKE_Fortran_FLAGS}" + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_COMPILE_FLAGS}> ) -if (WIN32 AND MSVC) - target_link_libraries (parallel_test "ws2_32.lib") +if (NOT BUILD_SHARED_LIBS) + target_link_libraries (parallel_test + PRIVATE + ${HDF5_F90_TEST_LIB_TARGET} ${HDF5_F90_LIB_TARGET} ${HDF5_LIB_TARGET} ${LINK_Fortran_LIBS} + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"ws2_32.lib"> + ) + set_target_properties (parallel_test PROPERTIES + FOLDER test/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/static + ) +else () + target_link_libraries (parallel_test + PRIVATE + ${HDF5_F90_TEST_LIBSH_TARGET} ${HDF5_F90_LIBSH_TARGET} ${HDF5_LIBSH_TARGET} ${LINK_Fortran_LIBS} + $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"ws2_32.lib"> + ) + set_target_properties (parallel_test PROPERTIES + FOLDER test/fortran + LINKER_LANGUAGE Fortran + Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/shared + ) endif () -target_include_directories (parallel_test PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}/static) -set_target_properties (parallel_test PROPERTIES LINKER_LANGUAGE Fortran) -set_target_properties (parallel_test PROPERTIES FOLDER test/fortran) -include (CMakeTests.cmake) +#set_property(TARGET parallel_test APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:"-SUBSYSTEM:CONSOLE">) +#set_property(TARGET parallel_test APPEND PROPERTY LINK_FLAGS $<$<STREQUAL:"x${CMAKE_Fortran_SIMULATE_ID}","xMSVC">:${WIN_LINK_FLAGS}>) +if(MSVC) + set_property(TARGET parallel_test PROPERTY LINK_FLAGS "/SUBSYSTEM:CONSOLE ${WIN_LINK_FLAGS}") +endif() + +if (HDF5_TEST_FORTRAN AND HDF5_TEST_PARALLEL) + include (CMakeTests.cmake) +endif () diff --git a/fortran/testpar/CMakeTests.cmake b/fortran/testpar/CMakeTests.cmake index 5736256..d0abe0e 100644 --- a/fortran/testpar/CMakeTests.cmake +++ b/fortran/testpar/CMakeTests.cmake @@ -15,4 +15,4 @@ ### T E S T I N G ### ############################################################################## ############################################################################## -add_test (NAME FORT_parallel_test COMMAND ${MPIEXEC} ${MPIEXEC_PREFLAGS} ${MPIEXEC_NUMPROC_FLAG} ${MPIEXEC_MAX_NUMPROCS} ${MPIEXEC_POSTFLAGS} $<TARGET_FILE:parallel_test>) +add_test (NAME MPI_TEST_FORT_parallel_test COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${MPIEXEC_MAX_NUMPROCS} ${MPIEXEC_PREFLAGS} $<TARGET_FILE:parallel_test> ${MPIEXEC_POSTFLAGS}) diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90 index 22f641d..605d69b 100644 --- a/fortran/testpar/hyper.f90 +++ b/fortran/testpar/hyper.f90 @@ -18,9 +18,10 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) USE HDF5 + USE MPI USE TH5_MISC + IMPLICIT NONE - INCLUDE 'mpif.h' INTEGER, INTENT(in) :: length ! array length LOGICAL, INTENT(in) :: do_collective ! use collective I/O @@ -134,7 +135,7 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) ! Collective metadata READ API calling requirement CALL h5pset_all_coll_metadata_ops_f(fapl_id, is_coll_true, hdferror) CALL check("h5pset_all_coll_metadata_ops_f", hdferror, nerrors) - + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) CALL check("h5fcreate_f", hdferror, nerrors) @@ -143,7 +144,7 @@ SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) CALL check("h5pclose_f", hdferror, nerrors) CALL h5fget_access_plist_f(file_id, fapl_id, hdferror) CALL check("h5fget_access_plist_f", hdferror, nerrors) - + ! verify settings for file access properties ! Collective metadata writes diff --git a/fortran/testpar/mdset.f90 b/fortran/testpar/mdset.f90 index 70d2939..3de61c3 100644 --- a/fortran/testpar/mdset.f90 +++ b/fortran/testpar/mdset.f90 @@ -18,9 +18,10 @@ SUBROUTINE multiple_dset_write(length, do_collective, do_chunk, mpi_size, mpi_rank, nerrors) USE HDF5 + USE MPI USE TH5_MISC + IMPLICIT NONE - INCLUDE 'mpif.h' INTEGER, INTENT(in) :: length ! array length LOGICAL, INTENT(in) :: do_collective ! use collective I/O diff --git a/fortran/testpar/ptest.f90 b/fortran/testpar/ptest.f90 index 14ac3b2..0721244 100644 --- a/fortran/testpar/ptest.f90 +++ b/fortran/testpar/ptest.f90 @@ -16,10 +16,10 @@ ! PROGRAM parallel_test - USE hdf5 + USE HDF5 USE MPI - USE TH5_MISC - + USE TH5_MISC + IMPLICIT NONE INTEGER :: mpierror ! MPI hdferror flag |