summaryrefslogtreecommitdiffstats
path: root/fortran/test
diff options
context:
space:
mode:
authorVailin Choi <vchoi@hdfgroup.org>2013-04-18 18:23:51 (GMT)
committerVailin Choi <vchoi@hdfgroup.org>2013-04-18 18:23:51 (GMT)
commit6ee0e05fb94445551840fcb80b9b1c254c736799 (patch)
tree0acf68cdc69dae2ff0e2a72b36e4efb6f8fbfd06 /fortran/test
parent94f89911545edce6fc9ebde2c83357cbda0bbd70 (diff)
downloadhdf5-6ee0e05fb94445551840fcb80b9b1c254c736799.zip
hdf5-6ee0e05fb94445551840fcb80b9b1c254c736799.tar.gz
hdf5-6ee0e05fb94445551840fcb80b9b1c254c736799.tar.bz2
[svn-r23599] Bring revisions 22802 : 23085 from trunk to revise_chunks.
h5committested.
Diffstat (limited to 'fortran/test')
-rw-r--r--fortran/test/CMakeLists.txt5
-rw-r--r--fortran/test/Makefile.am2
-rw-r--r--fortran/test/Makefile.in6
-rw-r--r--fortran/test/fortranlib_test_1_8.f90141
-rw-r--r--fortran/test/fortranlib_test_F03.f9037
-rw-r--r--fortran/test/tH5A.f904
-rw-r--r--fortran/test/tH5O.f90255
-rw-r--r--fortran/test/tH5O_F03.f90547
-rw-r--r--fortran/test/tH5T.f904
-rw-r--r--fortran/test/tH5T_F03.f90307
10 files changed, 1108 insertions, 200 deletions
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt
index d19baea..92ba651 100644
--- a/fortran/test/CMakeLists.txt
+++ b/fortran/test/CMakeLists.txt
@@ -100,12 +100,13 @@ ADD_TEST (NAME testhdf5_fortran_1_8 COMMAND $<TARGET_FILE:testhdf5_fortran_1_8>)
SET_TESTS_PROPERTIES(testhdf5_fortran_1_8 PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s")
#-- Adding test for fortranlib_test_F03
-IF (FORTRAN_HAVE_ISO_C_BINDING AND HDF5_ENABLE_F2003)
+IF (HDF5_ENABLE_F2003)
ADD_EXECUTABLE (fortranlib_test_F03
fortranlib_test_F03.f90
tH5F.f90
tH5E_F03.f90
tH5L_F03.f90
+ tH5O_F03.f90
tH5P_F03.f90
tH5T_F03.f90
)
@@ -124,7 +125,7 @@ IF (FORTRAN_HAVE_ISO_C_BINDING AND HDF5_ENABLE_F2003)
ADD_TEST (NAME fortranlib_test_F03 COMMAND $<TARGET_FILE:fortranlib_test_F03>)
SET_TESTS_PROPERTIES(fortranlib_test_F03 PROPERTIES PASS_REGULAR_EXPRESSION "[ ]*0 error.s")
-ENDIF (FORTRAN_HAVE_ISO_C_BINDING AND HDF5_ENABLE_F2003)
+ENDIF (HDF5_ENABLE_F2003)
#-- Adding test for fflush1
ADD_EXECUTABLE (fflush1 fflush1.f90)
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index b261785..42dd127 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -68,7 +68,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
if FORTRAN_2003_CONDITIONAL_F
fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
endif
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index e42b080..b9f05e3 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -136,11 +136,13 @@ fortranlib_test_1_8_LDADD = $(LDADD)
fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
$(LIBH5F) $(LIBHDF5)
am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 \
+ tH5T_F03.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT)
fortranlib_test_F03_OBJECTS = $(am_fortranlib_test_F03_OBJECTS)
@@ -525,7 +527,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index 321cb99..d3ced72 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -94,12 +94,6 @@ PROGRAM fortranlibtest
total_error)
ret_total_error = 0
- CALL test_nbit(cleanup, ret_total_error )
- CALL write_test_status(ret_total_error, &
- ' Testing nbit filter', &
- total_error)
-
- ret_total_error = 0
CALL test_scaleoffset(cleanup, ret_total_error )
CALL write_test_status(ret_total_error, &
' Testing scaleoffset filter', &
@@ -401,141 +395,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
END SUBROUTINE test_h5s_encode
!-------------------------------------------------------------------------
-! Function: test_nbit
-!
-! Purpose: Tests (real) datatype for nbit filter
-!
-! Return: Success: 0
-! Failure: >0
-!
-! Programmer: M. Scot Breitenfeld
-! Decemeber 7, 2010
-!
-! Modifications:
-!
-!-------------------------------------------------------------------------
-!
-
-SUBROUTINE test_nbit(cleanup, total_error )
-
- USE HDF5
-
- IMPLICIT NONE
- INTEGER, PARAMETER :: wp = KIND(1.0)
- LOGICAL, INTENT(IN) :: cleanup
- INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: file
-
- INTEGER(hid_t) :: dataset, datatype, space, dc
- INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
- INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
- ! orig_data[] are initialized to be within the range that can be represented by
- ! dataset datatype (no precision loss during datatype conversion)
- !
- REAL(kind=wp), DIMENSION(1:2,1:5) :: orig_data = RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
- 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
- REAL(kind=wp), DIMENSION(1:2,1:5) :: new_data
- INTEGER(size_t) :: PRECISION, offset
- INTEGER :: error
- LOGICAL :: status
- INTEGER*8 :: ii
- INTEGER(size_t) :: i, j
-
-
- ! check to see if filter is available
- CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
- IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
- total_error = -1 ! so return
- RETURN
- ENDIF
-
- CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
- CALL check("H5Fcreate_f", error, total_error)
-
- ! Define dataset datatype (integer), and set precision, offset
- CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
- CALL CHECK(" H5Tcopy_f", error, total_error)
- CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
- CALL CHECK(" H5Tset_fields_f", error, total_error)
- offset = 7
- CALL H5Tset_offset_f(datatype, offset, error)
- CALL CHECK(" H5Tset_offset_f", error, 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
- CALL H5Screate_simple_f(2, dims, space, error)
- CALL CHECK(" H5Screate_simple_f", error, total_error)
-
- ! USE nbit filter
- CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
- CALL CHECK(" H5Pcreate_f", error, total_error)
-
- CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
- CALL CHECK(" H5Pset_chunk_f", error, total_error)
- CALL H5Pset_nbit_f(dc, error)
- CALL CHECK(" H5Pset_nbit_f", error, total_error)
-
- ! Create the dataset
- CALL H5Dcreate_f(file, "nbit_real", datatype, &
- space, dataset, error, dc)
- CALL CHECK(" H5Dcreate_f", error, total_error)
-
- !----------------------------------------------------------------------
- ! STEP 1: Test nbit by setting up a chunked dataset and writing
- ! to it.
- !----------------------------------------------------------------------
- !
- CALL H5Dwrite_f(dataset, H5T_NATIVE_REAL, orig_data, dims, error)
- CALL CHECK(" H5Dwrite_f", error, total_error)
-
- !----------------------------------------------------------------------
- ! STEP 2: Try to read the data we just wrote.
- !----------------------------------------------------------------------
- !
- CALL H5Dread_f(dataset, H5T_NATIVE_REAL, new_data, dims, error)
- CALL CHECK(" H5Dread_f", error, total_error)
-
- ! Check that the values read are the same as the values written
- ! Assume size of long long = size of double
- !
- 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(new_data(i,j) .NE. orig_data(i,j))THEN
- total_error = total_error + 1
- WRITE(*,'(" Read different values than written.")')
- WRITE(*,'(" At index ", 2(1X,I0))') i, j
- EXIT i_loop
- END IF
- ENDDO j_loop
- ENDDO i_loop
-
- !----------------------------------------------------------------------
- ! Cleanup
- !----------------------------------------------------------------------
- !
- CALL H5Tclose_f(datatype, error)
- CALL CHECK(" H5Tclose_f", error, total_error)
- CALL H5Pclose_f(dc, error)
- CALL CHECK(" H5Pclose_f", error, total_error)
- CALL H5Sclose_f(space, error)
- CALL CHECK(" H5Sclose_f", error, total_error)
- CALL H5Dclose_f(dataset, error)
- CALL CHECK(" H5Dclose_f", error, total_error)
- CALL H5Fclose_f(file, error)
- CALL CHECK(" H5Fclose_f", error, total_error)
-
-END SUBROUTINE test_nbit
-
-!-------------------------------------------------------------------------
! Function: test_scaleoffset
!
! Purpose: Tests the integer datatype for scaleoffset filter
diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90
index 1b69f7f..a03241c 100644
--- a/fortran/test/fortranlib_test_F03.f90
+++ b/fortran/test/fortranlib_test_F03.f90
@@ -64,10 +64,7 @@ PROGRAM fortranlibtest_F03
! CALL write_test_status(ret_total_error, ' Test error API based on data I/O', total_error)
WRITE(*,*)
-! write(*,*)
-! write(*,*) '========================================='
-! write(*,*) 'Testing DATATYPE interface '
-! write(*,*) '========================================='
+
ret_total_error = 0
CALL test_array_compound_atomic(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing 1-D Array of Compound Datatypes Functionality', total_error)
@@ -117,16 +114,16 @@ PROGRAM fortranlibtest_F03
CALL write_test_status(ret_total_error, ' Testing writing/reading string datatypes, using C_LOC', total_error)
ret_total_error = 0
+ CALL vl_test_special_char(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing string datatypes containing control characters', total_error)
+
+ ret_total_error = 0
CALL test_create(ret_total_error)
- CALL write_test_status(ret_total_error, &
- ' Testing filling functions', &
- total_error)
+ CALL write_test_status(ret_total_error, ' Testing filling functions', total_error)
ret_total_error = 0
CALL test_h5kind_to_type(total_error)
- CALL write_test_status(ret_total_error, &
- ' Test function h5kind_to_type', &
- total_error)
+ CALL write_test_status(ret_total_error, ' Test function h5kind_to_type', total_error)
ret_total_error = 0
CALL test_array_bkg(ret_total_error)
@@ -138,14 +135,30 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_iter_group(ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error)
+ CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error)
+
+ ret_total_error = 0
+ CALL test_nbit(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error)
+
! write(*,*)
! write(*,*) '========================================='
! write(*,*) 'Testing GROUP interface '
! write(*,*) '========================================='
-
+ ret_total_error = 0
+ CALL test_h5o_refcount(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing object functions ', total_error)
+
+ ret_total_error = 0
+ CALL 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 write_test_status(ret_total_error, ' Testing object info functions ', total_error)
+
WRITE(*,*)
WRITE(*,*) ' ============================================ '
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index 03522f7..cecaded 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -100,7 +100,7 @@
CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back
! string attr data
CHARACTER :: attr_character_data = 'A'
- DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459
REAL, DIMENSION(1) :: attr_real_data = 4.0
INTEGER, DIMENSION(1) :: attr_integer_data = 5
INTEGER(HSIZE_T), DIMENSION(7) :: data_dims
@@ -109,7 +109,7 @@
CHARACTER :: aread_character_data ! variable to put read back Character attr data
INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data
INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data
- DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data
!
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index 247d1d0..b68e7ca 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -35,15 +35,8 @@ SUBROUTINE test_h5o(cleanup, total_error)
INTEGER, INTENT(OUT) :: total_error
INTEGER :: error
- ! /* Output message about test being performed */
- ! WRITE(*,*) "Testing Objects"
-
-!!$ test_h5o_open(); /* Test generic OPEN FUNCTION */
-!!$ test_h5o_open_by_addr(); /* Test opening objects by address */
-!!$ test_h5o_close(); /* Test generic CLOSE FUNCTION */
-!!$ test_h5o_refcount(); /* Test incrementing and decrementing reference count */
- CALL test_h5o_plist(total_error) ! /* Test object creation properties */
- CALL test_h5o_link(total_error) ! /* Test object link routine */
+ CALL test_h5o_plist(total_error) ! Test object creation properties
+ CALL test_h5o_link(total_error) ! Test object link routine
IF(cleanup) CALL h5_cleanup_f("TestFile", H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
@@ -100,6 +93,19 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer
INTEGER , DIMENSION(1:dim0) :: wdata2, & ! Write buffer
rdata2 ! Read buffer
+ LOGICAL :: link_exists
+ CHARACTER(LEN=8) :: chr_exact
+ CHARACTER(LEN=10) :: chr_lg
+ INTEGER(size_t) :: nlinks
+ INTEGER(HID_T) :: plist = -1
+
+ CHARACTER(LEN=20) :: dset_comment = "dataset comment"
+ CHARACTER(LEN=13) :: grp_comment = "group comment"
+ CHARACTER(LEN=10) :: comment_sm ! to small comment sized buffer
+ CHARACTER(LEN=15) :: comment ! exact comment sized buffer
+ CHARACTER(LEN=20) :: comment_lg ! large comment sized buffer
+ INTEGER(HSSIZE_T) :: comment_size
+ INTEGER(SIZE_T) :: comment_size2
! Initialize the raw data
DO i = 1, TEST6_DIM1
@@ -131,8 +137,6 @@ SUBROUTINE test_h5o_link(total_error)
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)
-!!$ ret = H5Pset_libver_bounds(fapl_id, (new_format ? H5F_LIBVER_LATEST : H5F_LIBVER_EARLIEST), H5F_LIBVER_LATEST);
-
! 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)
@@ -155,10 +159,9 @@ SUBROUTINE test_h5o_link(total_error)
! Create a dataset with no name using the committed datatype
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
-
+ !
! Write the data to the dataset
!EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, &
@@ -199,7 +202,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tclose_f(type_id, error)
CALL check("h5tclose_f", error, total_error)
-
! Re-open datatype using new link
CALL H5Topen_f(group_id, "datatype", type_id, error)
CALL check("h5topen_f", error, total_error)
@@ -208,12 +210,10 @@ SUBROUTINE test_h5o_link(total_error)
CALL H5Olink_f(group_id, file_id, "/group", error)
CALL check("H5Olink_f", error, total_error)
-
CALL h5gclose_f(group_id, error)
CALL check("h5gclose_f",error,total_error)
! 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)
@@ -236,7 +236,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tclose_f(type_id, error)
CALL check("h5tclose_f",error,total_error)
-
! Close remaining IDs
CALL h5sclose_f(space_id, error)
CALL check("h5sclose_f",error,total_error)
@@ -264,16 +263,214 @@ SUBROUTINE test_h5o_link(total_error)
CALL check("h5gcreate_f", error, total_error)
CALL h5gcreate_f(file_id,"/G1/G2/G3",group_id,error)
CALL check("h5gcreate_f", error, total_error)
+
+ ! Try putting a comment on the group /G1/G2/G3 by name
+ CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3", grp_comment, error)
+ CALL check("h5oset_comment_by_name_f", error, total_error)
+
+ comment_lg = ' '
+
+ 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
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Try putting a comment on the group /G1/G2/G3 by name with trailing blanks
+
+ CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3"//' ', grp_comment, error)
+ CALL check("h5oset_comment_by_name_f", error, total_error)
+
+ comment_lg = ' '
+
+ 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
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
!
! Create the dataset
!
CALL h5dcreate_f(group_id, dataset, H5T_STD_I32LE, space_id, dset_id, error)
CALL check("h5dcreate_f", error, total_error)
+
+ ! Putting a comment on the dataset
+ CALL h5oset_comment_f(dset_id, dset_comment, error)
+ CALL check("h5oset_comment_f", error, total_error)
+
+ ! Try reading into a buffer that is the correct size
+
+ 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
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+
+ ! Try reading into a buffer that is to small
+
+ 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
+
+ ! Try reading into a buffer that is larger then needed
+
+ comment_lg = ' '
+
+ 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
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(16:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+ !
+ ! Check optional parameter
+ !
+ 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
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+
+ ! CHECK h5oget_comment_by_name_f
+
+ ! Try reading into a buffer that is the correct size
+
+ 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
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Try with trailing blanks in the name
+
+ 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
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ !
+ ! Check optional parameter
+ !
+ 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
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
!
! Write the data to the dataset.
!
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata2, dims2, error)
CALL check("h5dwrite_f", error, total_error)
+
+ ! *************************
+ ! CHECK H5OEXISTS_BY_NAME_F
+ ! *************************
+
+ ! Create a soft link to /G1
+ CALL h5lcreate_soft_f("/G1", file_id, "/G1_LINK", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+
+ ! Create a soft link to /G1000, does not exist
+ CALL h5lcreate_soft_f("/G1000", file_id, "/G1_FALSE", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+ ! Create a soft link to /G1_LINK
+ CALL h5lcreate_soft_f("/G1_FALSE", file_id, "/G2_FALSE", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_exact = "/G1_LINK"
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_exact, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_lg = "/G1_LINK"
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_lg = "/G1_LINK "
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_FALSE", link_exists, error)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should not exist
+ IF(link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Check optional parameter
+
+ CALL h5pcreate_f(H5P_LINK_ACCESS_F,plist,error)
+ CALL check("h5pcreate_f",error,total_error)
+
+ nlinks = 2
+ CALL h5pset_nlinks_f(plist, nlinks, error)
+ CALL check("h5pset_nlinks_f", error, total_error)
+ ! 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), 2, total_error)
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.not.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
!
! Close and release resources.
!
@@ -283,6 +480,14 @@ SUBROUTINE test_h5o_link(total_error)
CALL check("h5sclose_f", error, total_error)
CALL h5gclose_f(group_id, error)
CALL check("h5gclose_f", error, total_error)
+
+ ! 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)
+
+ CALL h5oclose_f(group_id, error)
+ CALL check("h5gclose_f", error, total_error)
+
!
! create property to pass copy options
!
@@ -324,7 +529,7 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
CALL check("h5tcopy_f", error, total_error)
- ! create named datatype
+ ! create named datatype
CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
CALL check("h5tcommit_f", error, total_error)
@@ -346,8 +551,7 @@ SUBROUTINE test_h5o_link(total_error)
! Compare the datatypes
CALL h5tequal_f(tid, tid2, flag, error)
IF(.NOT.flag)THEN
- WRITE(*,*) "h5ocopy_f FAILED"
- total_error = total_error + 1
+ CALL check("h5ocopy_f FAILED", -1, total_error)
ENDIF
! close the destination datatype
@@ -436,7 +640,6 @@ 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)
-
! Create a group, dataset, and committed datatype within the file,
! using the respective type of creation property lists.
!
@@ -472,7 +675,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL h5sclose_f(dspace, error)
CALL check("h5sclose_f",error,total_error)
-
! Close current creation property lists
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
@@ -482,7 +684,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL check("h5pclose_f", error, total_error)
! Retrieve each object's creation property list
-
CALL H5Gget_create_plist_f(grp, gcpl, error)
CALL check("H5Gget_create_plist", error, total_error)
@@ -492,7 +693,6 @@ 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
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
@@ -509,9 +709,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
-
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
CALL h5pclose_f(dcpl,error)
@@ -552,7 +750,6 @@ 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
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
@@ -569,9 +766,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
-
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
CALL h5pclose_f(dcpl,error)
diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90
new file mode 100644
index 0000000..f060a7d
--- /dev/null
+++ b/fortran/test/tH5O_F03.f90
@@ -0,0 +1,547 @@
+!****h* root/fortran/test/tH5O_F03.f90
+!
+! NAME
+! tH5O_F03.f90
+!
+! FUNCTION
+! Test FORTRAN HDF5 H5O APIs which are dependent on FORTRAN 2003
+! features.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+
+! *****************************************
+! *** H 5 O T E S T S
+! *****************************************
+MODULE visit_cb
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: info_size = 9
+
+ !-------------------------------------------------------------------------
+ ! Function: visit_obj_cb
+ !
+ ! Purpose: Callback routine for visiting objects in a file
+ !
+ ! Return: Success: 0
+ ! Failure: -1
+ !
+ ! Programmer: M.S. Breitenfeld
+ ! July 12, 2012
+ ! Adopted from C test.
+ !
+ !-------------------------------------------------------------------------
+ !
+ ! Object visit structs
+ TYPE, bind(c) :: obj_visit_t
+ CHARACTER(LEN=1), DIMENSION(1:180) :: path ! Path to object
+ INTEGER :: type_obj ! type of object
+ END TYPE obj_visit_t
+
+ 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
+ END TYPE ovisit_ud_t
+
+CONTAINS
+
+ INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo, op_data) bind(C)
+
+ IMPLICIT NONE
+
+ INTEGER(HID_T) :: group_id
+ CHARACTER(LEN=1), DIMENSION(1:180) :: name
+ TYPE(h5o_info_t) :: oinfo
+ TYPE(ovisit_ud_t) :: op_data
+
+ INTEGER :: len, i
+ INTEGER :: idx
+
+ visit_obj_cb = 0
+
+ ! Since the name is generated in C and passed to a Fortran string, it
+ ! will be NULL terminated, so we need to find the end of the string.
+
+ len = 1
+ DO len = 1, 180
+ IF(name(len) .EQ. C_NULL_CHAR) EXIT
+ ENDDO
+
+ len = len - 1
+
+ ! Check for correct object information
+
+ idx = op_data%idx
+
+ 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
+
+ ENDDO
+
+ ! Advance to next location in expected output
+ op_data%idx = op_data%idx + 1
+
+ END FUNCTION visit_obj_cb
+
+END MODULE visit_cb
+
+!/****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O refcounting functions.
+!**
+!****************************************************************/
+
+SUBROUTINE test_h5o_refcount(total_error)
+
+ USE HDF5
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ CHARACTER(LEN=11), PARAMETER :: FILENAME = "th5o_ref.h5"
+ INTEGER, PARAMETER :: DIM0 = 5
+ INTEGER, PARAMETER :: DIM1 = 10
+ INTEGER(hid_t) :: fid ! HDF5 File ID
+ INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers
+ TYPE(h5o_info_t) :: oinfo ! Object info struct
+ INTEGER(hsize_t), DIMENSION(1:2) :: dims
+ INTEGER :: error ! Value returned from API calls
+
+ ! Create a new HDF5 file
+ CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error)
+ CALL check("h5fcreate_f", error, total_error)
+
+ ! Create a group, dataset, and committed datatype within the file
+ ! Create the group
+ CALL h5gcreate_f(fid, "group", grp, error)
+ CALL check("h5gcreate_f",error, total_error)
+
+ ! Commit the type inside the group
+ CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error)
+ CALL check("H5Tcopy_f",error, total_error)
+ CALL h5tcommit_f(fid, "datatype", dtype, error)
+ CALL check("h5tcommit_f", error, total_error)
+
+ ! Create the data space for the dataset.
+ dims(1) = DIM0
+ dims(2) = DIM1
+
+ CALL h5screate_simple_f(2, dims, dspace, error)
+ CALL check("h5screate_simple_f", error, total_error)
+
+ ! Create the dataset.
+ CALL h5dcreate_f(fid, "dataset", H5T_NATIVE_INTEGER, dspace, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+ CALL h5sclose_f(dspace, error)
+ CALL check("h5sclose_f", error, total_error)
+
+ ! Get ref counts for each object. They should all be 1, since each object has a hard link.
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Check h5oget_info
+ CALL h5oget_info_f(grp, oinfo, error)
+ CALL check("h5oget_info_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_f", -1, total_error)
+ ENDIF
+ IF(oinfo%type.NE.H5O_TYPE_GROUP_F)THEN
+ CALL check("h5oget_info_f", -1, total_error)
+ ENDIF
+
+ ! Increment each object's reference count.
+ CALL h5oincr_refcount_f(grp, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5oincr_refcount_f(dtype, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5oincr_refcount_f(dset, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+
+ ! Get ref counts for each object. They should all be 2 now.
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Decrement the reference counts and check that they decrease back to 1.
+ CALL h5odecr_refcount_f(grp, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5odecr_refcount_f(dtype, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5odecr_refcount_f(dset, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ CALL h5gclose_f(grp, error)
+ CALL check("h5gclose_f",error, total_error)
+ CALL h5tclose_f(dtype, error)
+ CALL check("h5tclose_f",error, total_error)
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f",error, total_error)
+
+END SUBROUTINE test_h5o_refcount
+
+!****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O visit functions.
+!**
+!****************************************************************
+
+SUBROUTINE obj_visit(total_error)
+
+ USE HDF5
+
+ USE visit_cb
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ TYPE(ovisit_ud_t), TARGET :: udata ! User-data for visiting
+ INTEGER(hid_t) :: fid = -1
+ INTEGER(hid_t) :: gid = -1 ! Group ID
+ TYPE(C_PTR) :: f_ptr
+ TYPE(C_FUNPTR) :: fun_ptr
+ CHARACTER(LEN=180) :: object_name
+ INTEGER :: ret_val
+ INTEGER :: error
+
+ ! Construct "interesting" file to visit
+ CALL build_visit_file(fid)
+
+ ! Inialize udata for testing purposes
+ udata%info(1)%path(1:1) ="."
+ udata%info(1)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(2)%path(1:12) = &
+ (/"D","a","t","a","s","e","t","_","z","e","r","o"/)
+ udata%info(2)%type_obj =H5O_TYPE_DATASET_F
+ udata%info(3)%path(1:6) = &
+ (/"G","r","o","u","p","1"/)
+ udata%info(3)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(4)%path(1:18) =&
+ (/"G","r","o","u","p","1","/","D","a","t","a","s","e","t","_","o","n","e"/)
+ udata%info(4)%type_obj = H5O_TYPE_DATASET_F
+ udata%info(5)%path(1:13) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2"/)
+ udata%info(5)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(6)%path(1:25) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","D","a","t","a","s","e","t","_","t","w","o"/)
+ udata%info(6)%type_obj = H5O_TYPE_DATASET_F
+ udata%info(7)%path(1:22) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","T","y","p","e","_","t","w","o"/)
+ udata%info(7)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
+ udata%info(8)%path(1:15) =&
+ (/"G","r","o","u","p","1","/","T","y","p","e","_","o","n","e"/)
+ udata%info(8)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
+ udata%info(9)%path(1:9) =&
+ (/"T","y","p","e","_","z","e","r","o"/)
+ 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
+ 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
+
+ object_name = "/"
+ udata%idx = 1
+
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error)
+ 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 h5fclose_f(fid, error)
+ CALL check("h5fclose_f",error, total_error)
+
+END SUBROUTINE obj_visit
+
+!****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O info functions.
+!**
+!****************************************************************
+
+SUBROUTINE obj_info(total_error)
+
+ USE HDF5
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ 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
+ TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read
+ TYPE(H5O_info_t) :: oinfo ! Object info struct
+ INTEGER :: count = 0 ! Count within iterated group
+ INTEGER :: error
+ TYPE(C_PTR) :: f_ptr
+
+ CHARACTER(LEN=6) :: GROUPNAME = "/group"
+ CHARACTER(LEN=6) :: GROUPNAME2 = "group2"
+ CHARACTER(LEN=6) :: GROUPNAME3 = "group3"
+ CHARACTER(LEN=5) :: DSETNAME = "/dset"
+ CHARACTER(LEN=5) :: DSETNAME2 = "dset2"
+
+ ! Create file with a group and a dataset containing an object reference to the group
+ CALL h5fcreate_f("get_info.h5", H5F_ACC_TRUNC_F, fid, error)
+ CALL check("h5fcreate_f",error, total_error)
+
+ ! Create dataspace to use for dataset
+ CALL h5screate_f(H5S_SCALAR_F, sid, error)
+ CALL check("h5screate_f",error,total_error)
+
+ ! Create group to refer to
+ CALL h5gcreate_f(fid, GROUPNAME, gid, error)
+ CALL check("h5gcreate_f",error,total_error)
+
+ ! Create nested groups
+ CALL h5gcreate_f(gid, GROUPNAME2, gid2, error)
+ CALL check("h5gcreate_f",error,total_error)
+ CALL h5gclose_f(gid2, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ CALL h5gcreate_f(gid, GROUPNAME3, gid2, error)
+ CALL check("h5gcreate_f",error,total_error)
+ CALL h5gclose_f(gid2, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ ! Create bottom dataset
+ CALL h5dcreate_f(gid, DSETNAME2, H5T_NATIVE_INTEGER, sid, did, error)
+ CALL check("h5dcreate_f",error, total_error)
+
+ CALL h5dclose_f(did, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ CALL h5gclose_f(gid, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ ! Create dataset
+ CALL h5dcreate_f(fid, DSETNAME, H5T_STD_REF_OBJ, sid, did, error)
+ CALL check("h5dcreate_f",error, total_error)
+
+ f_ptr = C_LOC(wref)
+
+ ! Create reference to group
+ CALL h5rcreate_f(fid, GROUPNAME, H5R_OBJECT_F, f_ptr, error)
+ CALL check("h5rcreate_f",error, total_error)
+
+ ! Write reference to disk
+ CALL h5dwrite_f(did, H5T_STD_REF_OBJ, f_ptr, error)
+ CALL check("h5dwrite_f",error, total_error)
+
+ ! Close objects
+ CALL h5dclose_f(did, error)
+ CALL check("h5dclose_f", error, total_error)
+ CALL h5sclose_f(sid, error)
+ CALL check("h5sclose_f", error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f", error, total_error)
+
+ ! Re-open file
+ CALL h5fopen_f("get_info.h5", H5F_ACC_RDWR_F, fid, error)
+ CALL check("h5fopen_f", error, total_error)
+
+ ! Re-open dataset
+ CALL h5dopen_f(fid, DSETNAME, did, error)
+ CALL check("h5dopen_f", error, total_error)
+
+ ! Read in the reference
+
+ f_ptr = C_LOC(rref)
+
+ CALL h5dread_f(did, H5T_STD_REF_OBJ, f_ptr, error)
+ CALL check("H5Dread_f",error, total_error)
+
+ ! Dereference to get the group
+
+ CALL h5rdereference_f(did, H5R_OBJECT_F, f_ptr, gid, error)
+ CALL check("h5rdereference_f", error, total_error)
+
+ CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error)
+ 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
+
+ ! Close objects
+ CALL h5dclose_f(did, error)
+ CALL check("h5dclose_f", error, total_error)
+ CALL h5gclose_f(gid, error)
+ CALL check("h5sclose_f", error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f", error, total_error)
+
+END SUBROUTINE obj_info
+
+!-------------------------------------------------------------------------
+! Function: build_visit_file
+!
+! Purpose: Build an "interesting" file to use for visiting links & objects
+!
+! Programmer: M. Scot Breitenfeld
+! July 12, 2012
+! NOTE: Adapted from C test.
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE build_visit_file(fid)
+
+ USE HDF5
+ IMPLICIT NONE
+
+ 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
+ CHARACTER(LEN=20) :: filename = 'visit.h5'
+ INTEGER :: error
+
+ ! Create file for visiting
+ CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error)
+
+ ! Create group
+ CALL H5Gcreate_f(fid, "/Group1", gid, error)
+
+ ! Create nested group
+ CALL H5Gcreate_f(gid, "Group2", gid2, error)
+
+ ! Close groups
+ CALL h5gclose_f(gid2, error)
+ CALL h5gclose_f(gid, error)
+
+ ! Create soft links to groups created
+ CALL H5Lcreate_soft_f("/Group1", fid, "/soft_one", error)
+ CALL H5Lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error)
+
+ ! Create dangling soft link
+ CALL H5Lcreate_soft_f("nowhere", fid, "/soft_dangle", error)
+
+ ! Create hard links to all groups
+ CALL H5Lcreate_hard_f(fid, "/", fid, "hard_zero", error)
+ CALL H5Lcreate_hard_f(fid, "/Group1", fid, "hard_one", error)
+ CALL H5Lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error)
+
+ ! Create loops w/hard links
+ CALL H5Lcreate_hard_f(fid, "/Group1", fid, "/Group1/hard_one", error)
+ CALL H5Lcreate_hard_f(fid, "/", fid, "/Group1/Group2/hard_zero", error)
+
+ ! Create dataset in each group
+ CALL H5Screate_f(H5S_SCALAR_F, sid, error)
+
+ CALL H5Dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Sclose_f(sid, error)
+
+ ! Create named datatype in each group
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+
+ CALL H5Tcommit_f(fid, "/Type_zero", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+ CALL H5Tcommit_f(fid, "/Group1/Type_one", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+ CALL H5Tcommit_f(fid, "/Group1/Group2/Type_two", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+END SUBROUTINE build_visit_file
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 9605c45..b42a8e6 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -86,8 +86,8 @@
CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out
INTEGER, DIMENSION(dimsize) :: int_member
INTEGER, DIMENSION(dimsize) :: int_member_out
- DOUBLE PRECISION, DIMENSION(dimsize) :: double_member
- DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member
+ REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out
REAL, DIMENSION(dimsize) :: real_member
REAL, DIMENSION(dimsize) :: real_member_out
INTEGER :: i
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index 215ac9e..1c4da8b 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -103,7 +103,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! 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
CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error)
@@ -1976,8 +1976,8 @@ SUBROUTINE t_regref(total_error)
INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
INTEGER(hssize_t) :: npoints
- TYPE(hdset_reg_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
- TYPE(hdset_reg_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
+ TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
+ TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
INTEGER(size_t) :: size
CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2
@@ -2058,7 +2058,6 @@ SUBROUTINE t_regref(total_error)
CALL check("h5sclose_f",error, total_error)
CALL h5fclose_f(file , error)
CALL check("h5fclose_f",error, total_error)
-
!
! Now we begin the read section of this example.
!
@@ -2095,10 +2094,11 @@ SUBROUTINE t_regref(total_error)
! Open the referenced object, retrieve its region as a
! dataspace selection.
!
- CALL H5Rdereference_f(dset, rdata(i), dset2, 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, rdata(i), space, error)
+
+ CALL H5Rget_region_f(dset, f_ptr, space, error)
CALL check("H5Rget_region_f",error, total_error)
!
@@ -2754,7 +2754,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dget_type_f",error, total_error)
CALL H5Tget_size_f(filetype, size, error)
CALL check("H5Tget_size_f",error, total_error)
- CALL VERIFY("H5Tget_size_f", size, sdim, total_error)
+ CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error)
!
! Get dataspace.
!
@@ -2800,4 +2800,295 @@ SUBROUTINE t_string(total_error)
END SUBROUTINE t_string
+SUBROUTINE vl_test_special_char(cleanup, total_error)
+
+ USE hdf5
+ IMPLICIT NONE
+
+ INTERFACE
+ SUBROUTINE setup_buffer(data_in, line_lengths, char_type)
+ USE hdf5
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+ CHARACTER(len=*), DIMENSION(:) :: data_in
+ INTEGER(size_t), DIMENSION(:) :: line_lengths
+ CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
+ END SUBROUTINE setup_buffer
+ END INTERFACE
+
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(OUT) :: total_error
+
+ CHARACTER(LEN=16), PARAMETER :: filename = "t_controlchar.h5"
+ INTEGER, PARAMETER :: line_length = 10
+ INTEGER(hid_t) :: file
+ INTEGER(hid_t) :: dataset0
+ CHARACTER(len=line_length), DIMENSION(1:100) :: data_in
+ CHARACTER(len=line_length), DIMENSION(1:100) :: data_out
+ INTEGER(size_t), DIMENSION(1:100) :: line_lengths
+ INTEGER(hid_t) :: string_id, space, dcpl
+ INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/0/)
+ INTEGER(hsize_t), DIMENSION(1:1) :: max_dims = (/0/)
+ INTEGER(hsize_t), DIMENSION(1:2) :: data_dims = (/0,0/)
+ INTEGER(hsize_t), DIMENSION(1:1) :: chunk =(/10/)
+ INTEGER, PARAMETER :: ncontrolchar = 7
+ CHARACTER(KIND=C_CHAR,LEN=1), DIMENSION(1:ncontrolchar) :: controlchar = &
+ (/C_ALERT, C_BACKSPACE,C_CARRIAGE_RETURN, C_FORM_FEED,C_HORIZONTAL_TAB,C_VERTICAL_TAB, C_NEW_LINE/)
+ INTEGER :: i, j, n, error
+ n = 8
+ !
+ ! Create a new file using the default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
+ CALL check("h5fcreate_f",error, total_error)
+
+ max_dims = (/H5S_UNLIMITED_F/)
+
+ !
+ ! Create the memory datatype.
+ !
+ CALL h5tcopy_f(h5t_string, string_id, error)
+ CALL check("h5tcopy_f", error, total_error)
+ CALL h5tset_strpad_f(string_id, h5t_str_nullpad_f, error)
+ CALL check("h5tset_strpad_f", error, total_error)
+ dims(1) = n
+ !
+ ! Create dataspace.
+ !
+ CALL h5screate_simple_f(1, dims, space, error, max_dims)
+ CALL check("h5screate_simple_f", error, total_error)
+ CALL h5pcreate_f(h5p_dataset_create_f, dcpl, 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
+ !
+ ! Create data with strings containing various control characters.
+ !
+ DO i = 1, ncontrolchar
+ !
+ ! Create the dataset, for the string with control character and write the string data to it.
+ !
+ CALL h5dcreate_f(file, controlchar(i), string_id, space, dataset0, error, dcpl)
+ CALL check("h5dcreate_f", error, total_error)
+ CALL setup_buffer(data_in(1:n), line_lengths, controlchar(i))
+ CALL h5dwrite_vl_f(dataset0, string_id, data_in(1:n), data_dims, line_lengths(1:n), error, space)
+ CALL check("h5dwrite_vl_f", error, total_error)
+ !
+ ! Read the string back.
+ !
+ 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
+ EXIT
+ ENDIF
+ ENDDO
+
+ CALL h5dclose_f(dataset0, error)
+ CALL check("h5dclose_f", error, total_error)
+ ENDDO
+
+ CALL h5pclose_f(dcpl, error)
+ CALL check("h5pclose_f", error, total_error)
+ CALL h5sclose_f(space, 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)
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+ 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
+ INTEGER, DIMENSION(1:3) :: letters
+ CHARACTER(LEN=3) :: lets
+ CHARACTER(KIND=C_CHAR,LEN=*) :: char_type
+ CHARACTER(KIND=C_CHAR,LEN=1) :: char_tmp
+ INTEGER :: i, j, n, ff
+
+ ! Convert the letters and special character to integers
+ lets = 'abc'
+
+ READ(lets,'(3A1)') letters
+ READ(char_type,'(A1)') ff
+ n = SIZE(data_in)
+ j = 1
+ DO i=1,n-1
+ IF( j .EQ. 4 )THEN
+ WRITE(char_tmp,'(A1)') ff
+ data_in(i:i) = char_tmp
+ ELSE
+ WRITE(char_tmp,'(A1)') letters(j)
+ data_in(i:i) = char_tmp
+ ENDIF
+ line_lengths(i) = LEN_TRIM(data_in(i))
+ j = j + 1
+ IF( j .EQ. 5 ) j = 1
+ END DO
+ WRITE(char_tmp,'(A1)') ff
+ data_in(n:n) = char_tmp
+ line_lengths(n) = 1
+
+END SUBROUTINE setup_buffer
+
+!-------------------------------------------------------------------------
+! Function: test_nbit
+!
+! Purpose: Tests (real, 4 byte) datatype for nbit filter
+!
+! Return: Success: 0
+! Failure: >0
+!
+! Programmer: M. Scot Breitenfeld
+! 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.
+! The need for this arises when a user specifies the default real is 8 bytes.
+! MSB 7/31/12
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE test_nbit(cleanup, total_error )
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+ INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ LOGICAL, INTENT(IN) :: cleanup
+ 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/)
+ ! orig_data[] are initialized to be within the range that can be represented by
+ ! dataset datatype (no precision loss during datatype conversion)
+ !
+ REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = &
+ RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
+ 5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
+ REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data
+ INTEGER(size_t) :: PRECISION, offset
+ INTEGER :: error
+ LOGICAL :: status
+ INTEGER(size_t) :: i, j
+ TYPE(C_PTR) :: f_ptr
+
+ ! check to see if filter is available
+ CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
+ IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
+ total_error = -1 ! so return
+ RETURN
+ ENDIF
+
+ CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
+ CALL check("H5Fcreate_f", error, total_error)
+
+ ! Define dataset datatype (integer), and set precision, offset
+ CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
+ CALL CHECK(" H5Tcopy_f", error, total_error)
+ CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
+ CALL CHECK(" H5Tset_fields_f", error, total_error)
+ offset = 7
+ CALL H5Tset_offset_f(datatype, offset, error)
+ CALL CHECK(" H5Tset_offset_f", error, 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
+ CALL H5Screate_simple_f(2, dims, space, error)
+ CALL CHECK(" H5Screate_simple_f", error, total_error)
+
+ ! USE nbit filter
+ CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
+ CALL CHECK(" H5Pcreate_f", error, total_error)
+
+ CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
+ CALL CHECK(" H5Pset_chunk_f", error, total_error)
+ CALL H5Pset_nbit_f(dc, error)
+ CALL CHECK(" H5Pset_nbit_f", error, total_error)
+
+ ! Create the dataset
+ CALL H5Dcreate_f(file, "nbit_real", datatype, &
+ space, dataset, error, dc)
+ CALL CHECK(" H5Dcreate_f", error, total_error)
+
+ !----------------------------------------------------------------------
+ ! STEP 1: Test nbit by setting up a chunked dataset and writing
+ ! to it.
+ !----------------------------------------------------------------------
+ !
+ mem_type_id = h5kind_to_type(wp,H5_REAL_KIND)
+
+ f_ptr = C_LOC(orig_data(1,1))
+ CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error)
+ CALL CHECK(" H5Dwrite_f", error, 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)
+
+ ! Check that the values read are the same as the values written
+ ! Assume size of long long = size of double
+ !
+ 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(new_data(i,j) .NE. orig_data(i,j))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" Read different values than written.")')
+ WRITE(*,'(" At index ", 2(1X,I0))') i, j
+ EXIT i_loop
+ END IF
+ ENDDO j_loop
+ ENDDO i_loop
+
+ !----------------------------------------------------------------------
+ ! Cleanup
+ !----------------------------------------------------------------------
+ !
+ CALL H5Tclose_f(datatype, error)
+ CALL CHECK(" H5Tclose_f", error, total_error)
+ CALL H5Pclose_f(dc, error)
+ CALL CHECK(" H5Pclose_f", error, total_error)
+ CALL H5Sclose_f(space, error)
+ CALL CHECK(" H5Sclose_f", error, total_error)
+ CALL H5Dclose_f(dataset, error)
+ CALL CHECK(" H5Dclose_f", error, total_error)
+ CALL H5Fclose_f(file, error)
+ CALL CHECK(" H5Fclose_f", error, total_error)
+
+END SUBROUTINE test_nbit
+