diff options
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/CMakeLists.txt | 1 | ||||
| -rw-r--r-- | fortran/test/Makefile.am | 2 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.F90 | 13 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_1_8.F90 | 6 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_F03.F90 | 10 | ||||
| -rw-r--r-- | fortran/test/tH5D.F90 | 170 | ||||
| -rw-r--r-- | fortran/test/tH5F.F90 | 2244 | ||||
| -rw-r--r-- | fortran/test/tH5F_F03.F90 | 177 | ||||
| -rw-r--r-- | fortran/test/tH5L_F03.F90 | 289 | ||||
| -rw-r--r-- | fortran/test/tH5MISC_1_8.F90 | 64 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.F90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5Sselect.F90 | 53 | ||||
| -rw-r--r-- | fortran/test/tHDF5_F03.F90 | 1 |
13 files changed, 1866 insertions, 1166 deletions
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 67c8b75..ff27943 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -285,7 +285,6 @@ endif () add_executable (fortranlib_test_F03 fortranlib_test_F03.F90 tH5E_F03.F90 - tH5F_F03.F90 tH5L_F03.F90 tH5O_F03.F90 tH5P_F03.F90 diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 6ceddd6..6d11dcc 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -46,7 +46,7 @@ fortranlib_test_SOURCES = tH5F.F90 tH5D.F90 tH5R.F90 tH5S.F90 tH5T.F90 tH5VL.F90 fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 tHDF5_1_8.F90 \ fortranlib_test_1_8.F90 -fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ +fortranlib_test_F03_SOURCES = tH5E_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 diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index eb587a9..e0a837a 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -92,6 +92,14 @@ PROGRAM fortranlibtest CALL file_space("file_space",cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' File free space test', total_error) + ret_total_error = 0 + CALL test_file_info("file_info",cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' File information test', total_error) + + ret_total_error = 0 + CALL test_get_file_image(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) + ! ! '=========================================' ! 'Testing DATASET Interface ' @@ -114,6 +122,11 @@ PROGRAM fortranlibtest CALL test_dset_fill(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Filling dataspace elements', total_error) + ! Direct chunk IO + ret_total_error = 0 + CALL test_direct_chunk_io(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Direct chunk IO', total_error) + ! ! '=========================================' ! 'Testing DATASPACE Interface ' diff --git a/fortran/test/fortranlib_test_1_8.F90 b/fortran/test/fortranlib_test_1_8.F90 index fde3faa..6b3e7fa 100644 --- a/fortran/test/fortranlib_test_1_8.F90 +++ b/fortran/test/fortranlib_test_1_8.F90 @@ -103,6 +103,12 @@ PROGRAM fortranlibtest ' Testing basic generic property list class creation functionality', & total_error) + ret_total_error = 0 + CALL test_freelist(ret_total_error) + CALL write_test_status(ret_total_error, & + ' Testing free list', & + total_error) + WRITE(*,*) WRITE(*,*) ' ============================================ ' diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 6c53cc0..85ab744 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -135,10 +135,14 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Test basic generic property list callback functionality', total_error) ret_total_error = 0 - CALL test_iter_group(ret_total_error) + CALL test_iter_group(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error) ret_total_error = 0 + CALL test_visit(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Testing link visit 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) @@ -171,10 +175,6 @@ PROGRAM fortranlibtest_F03 CALL test_obj_info(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) - ret_total_error = 0 - CALL test_get_file_image(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing VDS ' diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index b5ad6e8..8c1484f 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -990,8 +990,176 @@ CONTAINS ENDIF ENDDO - END SUBROUTINE test_dset_fill + SUBROUTINE test_direct_chunk_io(cleanup, total_error) + + USE ISO_C_BINDING + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=4), PARAMETER :: filename = "doIO" + CHARACTER(LEN=80) :: fix_filename + + CHARACTER(LEN=15), PARAMETER :: dsetname = "dset" + + 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) :: dcpl ! dataset creation property identifier + + ! + !dataset dimensions at creation time + ! + INTEGER, PARAMETER :: DIM0 = 4 + INTEGER, PARAMETER :: DIM1 = 32 + INTEGER(SIZE_T), PARAMETER :: CHUNK0 = DIM0 + INTEGER(SIZE_T), PARAMETER :: CHUNK1 = DIM1/2 + INTEGER(HSIZE_T), DIMENSION(2) :: offset + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/DIM0,DIM1/) + INTEGER, DIMENSION(CHUNK0,CHUNK1), TARGET :: wdata1, rdata1, wdata2, rdata2 + INTEGER(HSIZE_T), DIMENSION(2) :: chunk = (/CHUNK0, CHUNK1/) + INTEGER :: i, j, n + INTEGER :: error + TYPE(C_PTR) :: f_ptr + INTEGER :: filters + INTEGER(SIZE_T) :: sizeINT + INTEGER(HID_T) :: dxpl + + ! + !Create a new file using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl, error) + CALL check("h5pcreate_f",error,total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! Dataset Fortran + + CALL h5screate_simple_f(RANK, dims, dataspace, error) + 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, RANK, chunk, error) + CALL check("h5pset_chunk_f",error,total_error) + + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, dset_id, error, dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + n = 0 + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + n = n + 1 + wdata1(i,j) = n + wdata2(i,j) = n*10 + END DO + END DO + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeINT = storage_size(i, KIND=size_t)/storage_size(c_char_'a',c_size_t) +#else + sizeINT = SIZEOF(i) +#endif + + f_ptr = C_LOC(wdata1) + offset(1:2) = (/0, 0/) + CALL H5Dwrite_chunk_f(dset_id, 0, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error) + CALL check("h5dwrite_f",error,total_error) + + f_ptr = C_LOC(wdata2) + offset(1:2) = (/0, 16/) + CALL H5Dwrite_chunk_f(dset_id, 0, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error, dxpl) + CALL check("h5dwrite_f",error,total_error) + + 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 + ! + !Open the file. + ! + 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) + + f_ptr = C_LOC(rdata1) + filters = 99 + offset(1:2) = (/0, 0/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata1(i,j), wdata1(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0, total_error) + + f_ptr = C_LOC(rdata2) + offset(1:2) = (/0, 16/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error, dxpl) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata2(i,j), wdata2(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0, total_error) + + 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) + + CALL h5pclose_f(dxpl, 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) + + RETURN + END SUBROUTINE test_direct_chunk_io + END MODULE TH5D diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index c255755..a5b67ac 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -21,7 +21,7 @@ ! ! CONTAINS SUBROUTINES ! mountingtest, reopentest, get_name_test, plisttest, -! file_close, file_space, h5openclose +! file_close, file_space, h5openclose, test_get_file_image ! !***** ! @@ -30,8 +30,17 @@ ! access the dataset from the second file as a member of a group ! in the first file. +! ***************************************** +! *** H 5 F T E S T S +! ***************************************** + MODULE TH5F + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE ISO_C_BINDING + CONTAINS SUBROUTINE h5openclose(total_error) @@ -131,1008 +140,1311 @@ CONTAINS RETURN END SUBROUTINE h5openclose - SUBROUTINE mountingtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !the respective filename is "mount1.h5" and "mount2.h5" - ! - CHARACTER(LEN=6) :: filename1 - CHARACTER(LEN=6) :: filename2 - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=80) :: fix_filename2 - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 5 - - ! - ! File identifiers - ! - INTEGER(HID_T) :: file1_id, file2_id - - ! - ! Group identifier - ! - INTEGER(HID_T) :: gid - - ! - ! dataset identifier - ! - INTEGER(HID_T) :: dset_id - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - ! data type identifier - ! - INTEGER(HID_T) :: dtype_id - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !return value for testing whether a file is in hdf5 format - ! - LOGICAL :: status - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - 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 - ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out - - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - filename1 = "mount1" - filename2 = "mount2" - - do i = 1,80 - fix_filename1(i:i) = " " - fix_filename2(i:i) = " " - enddo - ! - !Initialize data_in buffer - ! - do j = 1, NY - do i = 1, NX - data_in(i,j) = (i-1) + (j-1) - end do - end do - - ! - ! Fix names of the files - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if(error .ne. 0) stop - 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 + SUBROUTINE mountingtest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error - ! - !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) + ! + ! the respective filenames are "mount1.h5" and "mount2.h5" + ! + CHARACTER(LEN=6) :: filename1 + CHARACTER(LEN=6) :: filename2 + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=80) :: fix_filename2 - 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) + ! + ! data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 - IF(obj_count.NE.5)THEN - total_error = total_error + 1 - ENDIF + ! + ! File identifiers + ! + INTEGER(HID_T) :: file1_id, file2_id - 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) + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid - 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) + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace - ! - !Create group "/G" inside file "mount1.h5". - ! - CALL h5gcreate_f(file1_id, "/G", gid, error) - CALL check("h5gcreate_f",error,total_error) - ! - !close file and group identifiers. - ! - CALL h5gclose_f(gid, error) - CALL check("h5gclose_f",error,total_error) - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Create second file "mount2.h5" using default properties. - ! - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/D" inside file "mount2.h5". - ! - CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - ! Write data_in to the dataset - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close file, dataset and dataspace identifiers. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !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 + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id - 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 + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - ! - !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) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename1, " is not in hdf5 format" - stop - END IF + ! + !return value for testing whether a file is in hdf5 format + ! + LOGICAL :: status - CALL h5fis_hdf5_f(fix_filename2, status, error) - CALL check("h5fis_hdf5_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename2, " is not in hdf5 format" - stop - END IF + ! + !flag to check operation success + ! + INTEGER :: error - ! - !reopen both files. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("hfopen_f",error,total_error) + ! + !general purpose integer + ! + INTEGER :: i, j - 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) + !number of objects + INTEGER(SIZE_T) :: obj_count + INTEGER(HID_T) :: t1, t2, t3, t4 - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! File numbers + INTEGER :: file_num1 + INTEGER :: file_num2 - CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) - CALL check("h5fopen_f",error,total_error) + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out - 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) + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + filename1 = "mount1" + filename2 = "mount2" - IF(obj_count.NE.2)THEN - total_error = total_error + 1 - ENDIF + do i = 1,80 + fix_filename1(i:i) = " " + fix_filename2(i:i) = " " + enddo + ! + !Initialize data_in buffer + ! + do j = 1, NY + do i = 1, NX + data_in(i,j) = (i-1) + (j-1) + end do + end do - ! - !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 + ! + ! Fix names of the files + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if(error .ne. 0) stop + 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 - ! - !mount the second file under the first file's "/G" group. - ! - CALL h5fmount_f (file1_id, "/G", file2_id, error) - CALL check("h5fmount_f",error,total_error) - - - ! - !Access dataset D in the first file under /G/D name. - ! - CALL h5dopen_f(file1_id, "/G/D", dset_id, error) - CALL check("h5dopen_f",error,total_error) - - ! - !Get dataset's data type. - ! - CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f",error,total_error) - - ! - !Read the dataset. - ! - CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) - CALL check("h5dread_f",error,total_error) - - ! - !Compare the data. - ! - 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 - - - ! - !Close dset_id and dtype_id. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f",error,total_error) - - ! - !unmount the second file. - ! - CALL h5funmount_f(file1_id, "/G", error); - CALL check("h5funmount_f",error,total_error) - - ! - !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 + ! + !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 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) - 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 - IF(obj_count.NE.0)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) - 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) - CALL check("h5_cleanup_f", error, total_error) - RETURN - END SUBROUTINE mountingtest + 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) -! -! The following subroutine tests h5freopen_f. -! It creates the file which has name "reopen.h5" and -! the "/dset" dataset inside the file. -! writes the data to the file, close the dataset. -! Reopen the file based upon the file_id, open the -! dataset use the reopen_id then reads the -! dataset back to memory to test whether the data -! read is identical to the data written -! + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF - SUBROUTINE reopentest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - CHARACTER(LEN=6), PARAMETER :: filename = "reopen" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: file_id, reopen_id ! File identifiers - INTEGER(HID_T) :: dset_id ! Dataset identifier - - ! - !dataset name is "dset" - ! - CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 6 - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - INTEGER :: i, j - - ! - !array to store data - ! - 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 - - ! - !initialize the dset_data array which will be written to the "/dset" - ! - do j = 1, NY - do i = 1, NX - dset_data(i,j) = (i-1)*6 + j; - end do - end do - - ! - !Create file "reopen.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/dset" inside the file . - ! - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - !Write the dataset. - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !close the dataspace. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - - ! - !Reopen file dsetf.h5. - ! - CALL h5freopen_f(file_id, reopen_id, error) - CALL check("h5freopen_f",error,total_error) - ! - !Check file size - ! - CALL h5fget_filesize_f(file_id, file_size, error) - 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) - CALL check("h5dopen_f",error,total_error) - ! - !Get file name from the dataset identifier - ! - CALL h5fget_name_f(dset_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN - write(*,*) "file name obtained from the dataset id is incorrect" - END IF - - ! - !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. - ! - do i = 1, NX - do j = 1, NY - IF (data_out(i,j) .NE. dset_data(i, j)) THEN - write(*, *) "reopen test error occurred" - END IF - end do - end do - - - ! - !Close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error,total_error) - CALL h5fclose_f(reopen_id, error) - 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 reopentest - -! The following subroutine checks that h5fget_name_f produces -! correct output for a given obj_id and filename. -! - SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - INTEGER(HID_T) :: obj_id ! Object identifier - CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename - INTEGER, INTENT(IN) :: len_filename ! The length of the filename - INTEGER, INTENT(INOUT) :: total_error ! Error count - - CHARACTER(LEN=80):: file_name ! Filename buffer - INTEGER:: error ! HDF5 error code - INTEGER(SIZE_T):: name_size ! Filename length - - INTEGER, PARAMETER :: sm_len = 2 - CHARACTER(LEN=len_filename) :: filename_exact - CHARACTER(LEN=len_filename-sm_len) :: filename_sm - - ! - !Get file name from the dataset identifier - ! - - ! Use an uninitialized buffer - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" + ! + !Create group "/G" inside file "mount1.h5". + ! + CALL h5gcreate_f(file1_id, "/G", gid, error) + CALL check("h5gcreate_f",error,total_error) + ! + !close file and group identifiers. + ! + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Create second file "mount2.h5" using default properties. + ! + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/D" inside file "mount2.h5". + ! + CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close file, dataset and dataspace identifiers. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !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) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not in hdf5 format" + stop + END IF + + CALL h5fis_hdf5_f(fix_filename2, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not in hdf5 format" + stop + END IF + + ! + !reopen both files. + ! + 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. + ! + CALL h5fmount_f (file1_id, "/G", file2_id, error) + CALL check("h5fmount_f",error,total_error) + + + ! + !Access dataset D in the first file under /G/D name. + ! + CALL h5dopen_f(file1_id, "/G/D", dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's data type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + 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 - ! Use a buffer initialized with spaces - file_name(:) = " " - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer initialized with non-whitespace characters - file_name(:) = "a" - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is the exact size needed to hold the filename - CALL h5fget_name_f(obj_id, filename_exact, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_exact .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is smaller than needed to hold the filename - CALL h5fget_name_f(obj_id, filename_sm, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - END SUBROUTINE check_get_name - -! The following subroutine tests h5fget_name_f. -! It creates the file which has name "filename.h5" and -! tests that h5fget_name_f also returns the name "filename.h5" -! - SUBROUTINE get_name_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - CHARACTER(LEN=*), PARAMETER :: filename = "filename" - CHARACTER(LEN=80) :: fix_filename - INTEGER :: len_filename - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: g_id ! Group identifier - - ! - ! Flag to check operation success - ! - INTEGER :: error - - ! - ! Create file "filename.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - IF (error .NE. 0) THEN - WRITE(*,*) "Cannot modify filename" - STOP - ENDIF - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - ! Create group. - ! - CALL h5gopen_f(file_id,"/",g_id, error) - CALL check("h5gopen_f",error,total_error) - - len_filename = LEN_TRIM(fix_filename) - CALL check_get_name(file_id, fix_filename, len_filename, total_error) - CALL check_get_name(g_id, fix_filename, len_filename, total_error) - - ! Close the group. - ! - CALL h5gclose_f(g_id, error) - CALL check("h5gclose_f",error,total_error) - - ! - ! Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) + ! + !Close dset_id and dtype_id. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + !unmount the second file. + ! + CALL h5funmount_f(file1_id, "/G", error); + CALL check("h5funmount_f",error,total_error) + + ! + !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) + CALL check("h5_cleanup_f", error, total_error) + RETURN + END SUBROUTINE mountingtest + + ! + ! The following subroutine tests h5freopen_f. + ! It creates the file which has name "reopen.h5" and + ! the "/dset" dataset inside the file. + ! writes the data to the file, close the dataset. + ! Reopen the file based upon the file_id, open the + ! dataset use the reopen_id then reads the + ! dataset back to memory to test whether the data + ! read is identical to the data written + ! + + SUBROUTINE reopentest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + CHARACTER(LEN=6), PARAMETER :: filename = "reopen" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: file_id, reopen_id ! File identifiers + INTEGER(HID_T) :: dset_id ! Dataset identifier + + ! + !dataset name is "dset" + ! + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 6 + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !array to store data + ! + 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 + + ! + !initialize the dset_data array which will be written to the "/dset" + ! + do j = 1, NY + do i = 1, NX + dset_data(i,j) = (i-1)*6 + j; + end do + end do + + ! + !Create file "reopen.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/dset" inside the file . + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + !Write the dataset. + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !close the dataspace. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Reopen file dsetf.h5. + ! + CALL h5freopen_f(file_id, reopen_id, error) + CALL check("h5freopen_f",error,total_error) + ! + !Check file size + ! + CALL h5fget_filesize_f(file_id, file_size, error) + 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) + CALL check("h5dopen_f",error,total_error) + ! + !Get file name from the dataset identifier + ! + CALL h5fget_name_f(dset_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN + write(*,*) "file name obtained from the dataset id is incorrect" + END IF + + ! + !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. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + write(*, *) "reopen test error occurred" + END IF + end do + end do + + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(reopen_id, error) + 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 reopentest + + ! The following subroutine checks that h5fget_name_f produces + ! correct output for a given obj_id and filename. + ! + SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + INTEGER(HID_T) :: obj_id ! Object identifier + CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename + INTEGER, INTENT(IN) :: len_filename ! The length of the filename + INTEGER, INTENT(INOUT) :: total_error ! Error count + + CHARACTER(LEN=80):: file_name ! Filename buffer + INTEGER:: error ! HDF5 error code + INTEGER(SIZE_T):: name_size ! Filename length + + INTEGER, PARAMETER :: sm_len = 2 + CHARACTER(LEN=len_filename) :: filename_exact + CHARACTER(LEN=len_filename-sm_len) :: filename_sm + + ! + !Get file name from the dataset identifier + ! + + ! Use an uninitialized buffer + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with spaces + file_name(:) = " " + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with non-whitespace characters + file_name(:) = "a" + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is the exact size needed to hold the filename + CALL h5fget_name_f(obj_id, filename_exact, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_exact .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is smaller than needed to hold the filename + CALL h5fget_name_f(obj_id, filename_sm, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + END SUBROUTINE check_get_name + + ! The following subroutine tests h5fget_name_f. + ! It creates the file which has name "filename.h5" and + ! tests that h5fget_name_f also returns the name "filename.h5" + ! + + SUBROUTINE get_name_test(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=*), PARAMETER :: filename = "filename" + CHARACTER(LEN=80) :: fix_filename + INTEGER :: len_filename + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: g_id ! Group identifier + + ! + ! Flag to check operation success + ! + INTEGER :: error + + ! + ! Create file "filename.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + ! Create group. + ! + CALL h5gopen_f(file_id,"/",g_id, error) + CALL check("h5gopen_f",error,total_error) + + len_filename = LEN_TRIM(fix_filename) + CALL check_get_name(file_id, fix_filename, len_filename, total_error) + CALL check_get_name(g_id, fix_filename, len_filename, total_error) + + ! Close the group. + ! + CALL h5gclose_f(g_id, error) + CALL check("h5gclose_f",error,total_error) + + ! + ! Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + 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 get_name_test + + + ! + ! The following example demonstrates how to get creation property list, + ! and access property list. + ! We first create a file using the default creation and access property + ! list. Then, the file was closed and reopened. We then get the + ! creation and access property lists of the first file. The second file is + ! created using the got property lists + + SUBROUTINE plisttest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + !file names are "plist1.h5" and "plist2.h5" + ! + CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" + CHARACTER(LEN=80) :: fix_filename2 + + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: prop_id ! File creation property list identifier + INTEGER(HID_T) :: access_id ! File Access property list identifier + + !flag to check operation success + INTEGER :: error + + ! + !Create a file1 using default properties. + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Terminate access to the file. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Open an existing file. + ! + CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !get the creation property list. + ! + CALL h5fget_create_plist_f(file1_id, prop_id, error) + CALL check("h5fget_create_plist_f",error,total_error) + + ! + !get the access property list. + ! + CALL h5fget_access_plist_f(file1_id, access_id, error) + CALL check("h5fget_access_plist_f",error,total_error) + + ! + !based on the creation property list id and access property list id + !create a new file + ! + CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & + prop_id, access_id) + CALL check("h5create_f",error,total_error) + + ! + !Close all the property lists. + ! + CALL h5pclose_f(prop_id, error) + CALL check("h5pclose_f",error,total_error) + CALL h5pclose_f(access_id, error) + CALL check("h5pclose_f",error,total_error) + + ! + !Terminate access to the files. + ! + 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) + + 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) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE plisttest + + + ! + ! The following subroutine tests h5pget(set)_fclose_degree_f + ! + + SUBROUTINE file_close(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + + ! + CHARACTER(LEN=10), PARAMETER :: filename = "file_close" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers + INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers + INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers + LOGICAL :: flag + INTEGER(SIZE_T) :: obj_count, obj_countf + INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids + INTEGER(SIZE_T) :: i + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) + CALL check("h5fopen_f",error,total_error) + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) + CALL check("h5fopen_f",error,total_error) + CALL h5fget_access_plist_f(fid1, fid1_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + + CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) + CALL check("h5pequal_f",error,total_error) + if (.NOT. flag) then + write(*,*) " File access lists should be equal, error " + total_error=total_error + 1 + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_SEMI should fail " + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_STRONG should fail " + endif + + CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_count .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_countf .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + allocate(obj_ids(obj_countf), stat = error) + CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) + CALL check("h5fget_obj_ids_f",error,total_error) + if(error .eq. 0) then + do i = 1, obj_countf + CALL h5fclose_f(obj_ids(i), error) CALL check("h5fclose_f",error,total_error) + enddo + endif + + CALL h5fclose_f(fid, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid1, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid_d, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + + if(cleanup) then + CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + endif + deallocate(obj_ids) + RETURN - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN + END SUBROUTINE file_close - END SUBROUTINE get_name_test + ! + ! The following subroutine tests h5fget_freespace_f + ! + SUBROUTINE file_space(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HSSIZE_T) :: free_space + INTEGER(HID_T) :: group_id ! Group identifier + + INTEGER(HID_T) :: fcpl + INTEGER(HSIZE_T), PARAMETER :: set_usrblck_size = 512 + INTEGER(HSIZE_T) :: usrblck_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL H5Pset_userblock_f(fcpl, set_usrblck_size, error ) + CALL check("h5pset_userblock_f", error, total_error) + + CALL H5Pget_userblock_f(fcpl, usrblck_size, error ) + CALL check("h5pget_userblock_f", error, total_error) + + IF(usrblck_size .NE. set_usrblck_size) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong size of a user block, ", usrblck_size + ENDIF + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, creation_prp=fcpl ) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pclose_f(fcpl, error) + CALL check("H5Pclose_f", error, total_error) + + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "1: Wrong amount of free space reported, ", free_space + ENDIF + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 216) THEN + total_error = total_error + 1 + WRITE(*,*) "2: Wrong amount of free space reported, ", free_space + ENDIF + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "3: Wrong amount of free space reported, ", free_space + ENDIF + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN -! -! The following example demonstrates how to get creation property list, -! and access property list. -! We first create a file using the default creation and access property -! list. Then, the file was closed and reopened. We then get the -! creation and access property lists of the first file. The second file is -! created using the got property lists - - SUBROUTINE plisttest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !file names are "plist1.h5" and "plist2.h5" - ! - CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" - CHARACTER(LEN=80) :: fix_filename2 - - INTEGER(HID_T) :: file1_id, file2_id ! File identifiers - INTEGER(HID_T) :: prop_id ! File creation property list identifier - INTEGER(HID_T) :: access_id ! File Access property list identifier - - !flag to check operation success - INTEGER :: error - - ! - !Create a file1 using default properties. - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Terminate access to the file. - ! - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Open an existing file. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("h5fopen_f",error,total_error) - - ! - !get the creation property list. - ! - CALL h5fget_create_plist_f(file1_id, prop_id, error) - CALL check("h5fget_create_plist_f",error,total_error) - - ! - !get the access property list. - ! - CALL h5fget_access_plist_f(file1_id, access_id, error) - CALL check("h5fget_access_plist_f",error,total_error) - - ! - !based on the creation property list id and access property list id - !create a new file - ! - CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & - prop_id, access_id) - CALL check("h5create_f",error,total_error) - - ! - !Close all the property lists. - ! - CALL h5pclose_f(prop_id, error) - CALL check("h5pclose_f",error,total_error) - CALL h5pclose_f(access_id, error) - CALL check("h5pclose_f",error,total_error) - - ! - !Terminate access to the files. - ! - 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) - - 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) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE plisttest + END SUBROUTINE file_space + ! + ! The following subroutine tests h5fget_info_f + ! -! -! The following subroutine tests h5pget(set)_fclose_degree_f -! + SUBROUTINE test_file_info(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HID_T) :: group_id ! Group identifier + + TYPE(H5F_INFO_T) :: file_info + INTEGER(HID_T) :: fapl, fcpl + INTEGER :: strategy + LOGICAL :: persist + INTEGER(HSIZE_T) :: threshold, fsp_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, 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 h5pset_file_space_strategy_f(fcpl, H5F_FSPACE_STRATEGY_PAGE_F, .TRUE., 4_HSIZE_T, error) + CALL check("h5pset_file_space_strategy_f",error, total_error) + + CALL h5pget_file_space_strategy_f(fcpl, strategy, persist, threshold, error) + CALL check("h5pget_file_space_strategy_f",error, total_error) + + IF(strategy .NE. H5F_FSPACE_STRATEGY_PAGE_F) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong strategy, ",strategy + ENDIF + IF(persist .NEQV. .TRUE.) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong persist, ",persist + ENDIF + IF(threshold .NE. 4_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong threshold, ",threshold + ENDIF + + CALL h5pset_file_space_page_size_f(fcpl, 512_HSIZE_T, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + CALL h5pget_file_space_page_size_f(fcpl, fsp_size, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + IF(fsp_size .NE. 512_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_page_size_f: wrong size, ",fsp_size + ENDIF + + CALL h5pset_alignment_f(fapl, 1_HSIZE_T, 1024_HSIZE_T, error) + CALL check("h5pset_alignment_f",error, total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl, creation_prp=fcpl) + CALL check("h5fcreate_f",error,total_error) + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check H5Fget_info_f + CALL h5fget_info_f(fid, file_info, error) + CALL check("h5fget_info_f", error, total_error) + + IF(file_info%super%version .NE. 3) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%version, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_size .NE. 48) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_size, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_ext_size .NE. 156) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_ext_size, ",file_info%super%super_ext_size + ENDIF + + IF(file_info%free%version .NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%version, ",file_info%free%version + ENDIF + + IF(file_info%free%tot_space .NE. 161) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%tot_space, ",file_info%free%tot_space + ENDIF + + IF(file_info%sohm%version.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%version ",file_info%sohm%version + ENDIF + + IF(file_info%sohm%hdr_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%hdr_size ",file_info%sohm%hdr_size + ENDIF + + IF(file_info%sohm%msgs_info%heap_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%heap_size + ENDIF + + IF(file_info%sohm%msgs_info%index_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%index_size + ENDIF + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5pclose_f(fapl, error) + CALL check("H5Pclose_f", error, total_error) + CALL h5pclose_f(fcpl, 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) + RETURN - SUBROUTINE file_close(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - - ! - CHARACTER(LEN=10), PARAMETER :: filename = "file_close" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers - INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers - INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers - LOGICAL :: flag - INTEGER(SIZE_T) :: obj_count, obj_countf - INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids - INTEGER(SIZE_T) :: i - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) - CALL check("h5fopen_f",error,total_error) - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) - CALL check("h5fopen_f",error,total_error) - CALL h5fget_access_plist_f(fid1, fid1_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - - CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) - CALL check("h5pequal_f",error,total_error) - if (.NOT. flag) then - write(*,*) " File access lists should be equal, error " - total_error=total_error + 1 - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_SEMI should fail " - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_STRONG should fail " - endif - - CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_count .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_countf .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - allocate(obj_ids(obj_countf), stat = error) - CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) - CALL check("h5fget_obj_ids_f",error,total_error) - if(error .eq. 0) then - do i = 1, obj_countf - CALL h5fclose_f(obj_ids(i), error) - CALL check("h5fclose_f",error,total_error) - enddo - endif - - CALL h5fclose_f(fid, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid1, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid_d, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - - if(cleanup) then - CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - endif - deallocate(obj_ids) - RETURN - - END SUBROUTINE file_close + END SUBROUTINE test_file_info -! -! The following subroutine tests h5fget_freespace_f -! + SUBROUTINE test_get_file_image(total_error) + ! + ! Tests the wrapper for h5fget_file_image + ! + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error ! returns error + + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f + + INTEGER, DIMENSION(1:100), TARGET :: data ! Write data + INTEGER :: file_sz + INTEGER(size_t) :: i + INTEGER(hid_t) :: file_id = -1 ! File identifier + INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier + INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier + INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions + INTEGER(size_t) :: itmp_a ! General purpose integer + INTEGER(size_t) :: image_size ! Size of image + TYPE(C_PTR) :: f_ptr ! Pointer + INTEGER(hid_t) :: fapl ! File access property + INTEGER :: error ! Error flag + + ! Create new properties for file access + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set standard I/O driver + CALL h5pset_fapl_stdio_f(fapl, error) + CALL check("h5pset_fapl_stdio_f", error, total_error) + + ! Create the file + 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 + 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 + 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 + 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) + + ! Flush the file + 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(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') + ! Get the size of the test file + ! + ! Since we use the eoa to calculate the image size, the file size + ! 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 + INQUIRE(UNIT=10, SIZE=file_sz) + CLOSE(UNIT=10) + + ! I. Get buffer size needed to hold the buffer + + ! A. Preferred way to get the size + f_ptr = C_NULL_PTR + CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) + CALL check("h5fget_file_image_f",error, total_error) + CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) + + ! B. f_ptr set to point to an incorrect buffer, should pass anyway + f_ptr = C_LOC(data(1)) + itmp_a = 1 + CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) + CALL check("h5fget_file_image_f",error, 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(image_ptr(1:image_size)) + + ! Load the image of the file into the buffer + f_ptr = C_LOC(image_ptr(1)(1:1)) + 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 + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + ! Close the test file + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error, 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(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') + + ! Read the test file from disk into the buffer + DO i = 1, image_size + READ(10) file_image_ptr(i) + ENDDO + + CLOSE(10) + + ! verify the file and the image contain the same data + DO i = 1, image_size + ! convert one byte to an unsigned integer + IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + ! release resources + DEALLOCATE(file_image_ptr,image_ptr) - SUBROUTINE file_space(filename, cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - CHARACTER(*), INTENT(IN) :: filename - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - ! - CHARACTER(LEN=3), PARAMETER :: grpname = "grp" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid ! File identifiers - INTEGER(HSSIZE_T) :: free_space - INTEGER(HID_T) :: group_id ! Group identifier - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "1: Wrong amount of free space reported, ", free_space - endif - - ! Create group in the file. - CALL h5gcreate_f(fid, grpname, group_id, error) - CALL check("h5gcreate_f",error,total_error) - - ! Close group - CALL h5gclose_f(group_id, error) - CALL check("h5gclose_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 216) then - total_error = total_error + 1 - write(*,*) "2: Wrong amount of free space reported, ", free_space - endif - - !Unlink the group - CALL h5gunlink_f(fid, grpname, error) - CALL check("h5gunlink_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "3: Wrong amount of free space reported, ", free_space - endif - - CALL h5fclose_f(fid, error) - 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 file_space + END SUBROUTINE test_get_file_image END MODULE TH5F diff --git a/fortran/test/tH5F_F03.F90 b/fortran/test/tH5F_F03.F90 deleted file mode 100644 index 27bd30e..0000000 --- a/fortran/test/tH5F_F03.F90 +++ /dev/null @@ -1,177 +0,0 @@ -!****h* root/fortran/test/tH5F_F03 -! -! NAME -! tH5F_F03.F90 -! -! FUNCTION -! Test FORTRAN HDF5 H5F APIs which are dependent on FORTRAN 2003 -! features. -! -! COPYRIGHT -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! 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://www.hdfgroup.org/licenses. * -! If you do not have access to either file, you may request a copy from * -! help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! NOTES -! Tests the H5F APIs functionalities of: -! h5fget_file_image_f -! -! CONTAINS SUBROUTINES -! test_get_file_image -! -!***** - -! ***************************************** -! *** H 5 F T E S T S -! ***************************************** - -MODULE TH5F_F03 - - USE HDF5 - USE TH5_MISC - USE TH5_MISC_GEN - USE ISO_C_BINDING - -CONTAINS - -SUBROUTINE test_get_file_image(total_error) - ! - ! Tests the wrapper for h5fget_file_image - ! - IMPLICIT NONE - - INTEGER, INTENT(INOUT) :: total_error ! returns error - - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f - - INTEGER, DIMENSION(1:100), TARGET :: data ! Write data - INTEGER :: file_sz - INTEGER(size_t) :: i - INTEGER(hid_t) :: file_id = -1 ! File identifier - INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier - INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier - INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions - INTEGER(size_t) :: itmp_a ! General purpose integer - INTEGER(size_t) :: image_size ! Size of image - TYPE(C_PTR) :: f_ptr ! Pointer - INTEGER(hid_t) :: fapl ! File access property - INTEGER :: error ! Error flag - - ! Create new properties for file access - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f", error, total_error) - - ! Set standard I/O driver - CALL h5pset_fapl_stdio_f(fapl, error) - CALL check("h5pset_fapl_stdio_f", error, total_error) - - ! Create the file - 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 - 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 - 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 - 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) - - ! Flush the file - 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(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') - ! Get the size of the test file - ! - ! Since we use the eoa to calculate the image size, the file size - ! 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 - INQUIRE(UNIT=10, SIZE=file_sz) - CLOSE(UNIT=10) - - ! I. Get buffer size needed to hold the buffer - - ! A. Preferred way to get the size - f_ptr = C_NULL_PTR - CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) - CALL check("h5fget_file_image_f",error, total_error) - CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - - ! B. f_ptr set to point to an incorrect buffer, should pass anyway - f_ptr = C_LOC(data(1)) - itmp_a = 1 - CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) - CALL check("h5fget_file_image_f",error, 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(image_ptr(1:image_size)) - - ! Load the image of the file into the buffer - f_ptr = C_LOC(image_ptr(1)(1:1)) - 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 - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - ! Close the test file - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error, 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(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') - - ! Read the test file from disk into the buffer - DO i = 1, image_size - READ(10) file_image_ptr(i) - ENDDO - - CLOSE(10) - - ! verify the file and the image contain the same data - DO i = 1, image_size - ! convert one byte to an unsigned integer - IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN - total_error = total_error + 1 - EXIT - ENDIF - ENDDO - - ! release resources - DEALLOCATE(file_image_ptr,image_ptr) - -END SUBROUTINE test_get_file_image - -END MODULE TH5F_F03 diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index e09ad5e..a8345c3 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -27,11 +27,21 @@ ! test_iter_group ! !***** + +MODULE EXTENTS + + IMPLICIT NONE + + INTEGER, PARAMETER :: MAX_CHAR_LEN = 30 + +END MODULE EXTENTS + MODULE liter_cb_mod USE HDF5 USE TH5_MISC USE TH5_MISC_GEN + USE EXTENTS USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -44,7 +54,7 @@ MODULE liter_cb_mod ! Custom group iteration callback data TYPE, bind(c) :: iter_info - CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object + CHARACTER(KIND=C_CHAR), DIMENSION(1:MAX_CHAR_LEN) :: 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 @@ -62,7 +72,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), VALUE :: group - CHARACTER(LEN=1), DIMENSION(1:10) :: name + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name TYPE (H5L_info_t) :: link_info @@ -72,13 +82,23 @@ CONTAINS INTEGER, SAVE :: count INTEGER, SAVE :: count2 + INTEGER :: nlen, i + liter_cb = 0 !!$ iter_info *info = (iter_info *)op_data; !!$ static int count = 0; !!$ static int count2 = 0; - - op_data%name(1:10) = name(1:10) + nlen = 0 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + op_data%name(1:nlen) = name(1:nlen) + ENDIF SELECT CASE (op_data%command) @@ -105,6 +125,63 @@ CONTAINS END FUNCTION liter_cb END MODULE liter_cb_mod +MODULE lvisit_cb_mod + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE EXTENTS + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + + ! Custom group iteration callback data + TYPE, bind(c) :: visit_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:11*MAX_CHAR_LEN) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value + INTEGER(c_int) :: n_obj ! The TYPE of RETURN value + END TYPE visit_info + +CONTAINS + +!*************************************************************** +!** +!** lvisit_cb(): Custom link visit callback routine. +!** +!*************************************************************** + + INTEGER(KIND=C_INT) FUNCTION lvisit_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name + + TYPE(H5L_info_t) :: link_info + TYPE(visit_info) :: op_data + + INTEGER :: nlen, i, istart, iend + + op_data%n_obj = op_data%n_obj + 1 + + nlen = 1 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + istart = (op_data%n_obj-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + op_data%name(istart:istart+nlen-1) = name(1:nlen) + ENDIF + + lvisit_cb = 0 + + END FUNCTION lvisit_cb +END MODULE lvisit_cb_mod + MODULE TH5L_F03 CONTAINS @@ -119,18 +196,20 @@ CONTAINS !** test_iter_group(): Test group iteration functionality !** !*************************************************************** -SUBROUTINE test_iter_group(total_error) +SUBROUTINE test_iter_group(cleanup, total_error) USE liter_cb_mod IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup 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(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" @@ -165,7 +244,6 @@ SUBROUTINE test_iter_group(total_error) f1 = C_FUNLOC(liter_cb) f2 = C_LOC(info) - CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) CALL check("H5Literate_f", error, total_error) @@ -198,7 +276,7 @@ SUBROUTINE test_iter_group(total_error) lnames(ndatasets+2) = "grp0000000" !!$ -!!$ lnames[NDATASETS] = HDstrdup("grp"); +!!$ lnames[NDATASETS] = strdup("grp"); !!$ CHECK(lnames[NDATASETS], NULL, "strdup"); !!$ @@ -311,6 +389,195 @@ SUBROUTINE test_iter_group(total_error) CALL H5Fclose_f(file, error) CALL check("H5Fclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f("titerate", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + END SUBROUTINE test_iter_group +!*************************************************************** +!** +!** Test HL visit functionality +!** +!*************************************************************** +SUBROUTINE test_visit(cleanup, total_error) + + USE lvisit_cb_mod + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: gid, gid2 ! Group IDs + INTEGER(HID_T) :: sid ! Dataspace ID + INTEGER(HID_T) :: did ! Dataset ID + CHARACTER(LEN=11) :: DATAFILE = "tvisit.h5" + + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + TYPE(visit_info), TARGET :: udata + + CHARACTER(LEN=MAX_CHAR_LEN), DIMENSION(1:11) :: obj_list + CHARACTER(LEN=MAX_CHAR_LEN) :: tmp + INTEGER :: error + INTEGER :: istart, iend, i, j + INTEGER :: ret_val + + obj_list(1) = "Dataset_zero" + obj_list(2) = "Group1" + obj_list(3) = "Group1/Dataset_one" + obj_list(4) = "Group1/Group2" + obj_list(5) = "Group1/Group2/Dataset_two" + obj_list(6) = "hard_one" + obj_list(7) = "hard_two" + obj_list(8) = "hard_zero" + obj_list(9) = "soft_dangle" + obj_list(10) = "soft_one" + obj_list(11) = "soft_two" + + fid = H5I_INVALID_HID_F + gid = H5I_INVALID_HID_F + gid2 = H5I_INVALID_HID_F + sid = H5I_INVALID_HID_F + did = H5I_INVALID_HID_F + + ! 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 + 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 + CALL h5fcreate_f(DATAFILE, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Create group + CALL h5gcreate_f(fid, "/Group1", gid, error) + CALL check("h5gcreate_f", error, total_error) + + ! Create nested group + CALL h5gcreate_f(gid, "Group2", gid2, error) + CALL check("h5gcreate_f", error, total_error) + + ! 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) + + ! Create soft links to groups created + CALL h5lcreate_soft_f("/Group1", fid, "/soft_one", error) + CALL check("h5lcreate_soft_f", error, total_error) + + CALL h5lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create dangling soft link + CALL h5lcreate_soft_f("nowhere", fid, "/soft_dangle", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create hard links to all groups + CALL h5lcreate_hard_f(fid, "/", fid, "hard_zero", error) + CALL check("h5lcreate_hard_f1", error, total_error) + + CALL h5lcreate_hard_f(fid, "/Group1", fid, "hard_one", error) + CALL check("h5lcreate_hard_f2", error, total_error) + CALL h5lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error) + CALL check("h5lcreate_hard_f3", error, total_error) + + ! Create dataset in each group + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f", error, total_error) + + CALL h5dcreate_f(fid, "/Dataset_zero", 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 h5dcreate_f(fid, "/Group1/Dataset_one", 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 h5dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f3", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + + ! Test visit functions + + f1 = C_FUNLOC(lvisit_cb) + f2 = C_LOC(udata) + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) + CALL check("h5lvisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5lvisit_f", -1, total_error) + ENDIF + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)) )THEN + CALL check("h5lvisit_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) + CALL check("h5lvisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_by_name_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)) )THEN + CALL check("h5lvisit_by_name_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("tvisit", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + +END SUBROUTINE test_visit + END MODULE TH5L_F03 diff --git a/fortran/test/tH5MISC_1_8.F90 b/fortran/test/tH5MISC_1_8.F90 index 85f9634..bd3ce3f 100644 --- a/fortran/test/tH5MISC_1_8.F90 +++ b/fortran/test/tH5MISC_1_8.F90 @@ -476,4 +476,68 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) END SUBROUTINE test_scaleoffset +SUBROUTINE test_freelist(total_error) + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid + INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/8/) + INTEGER(hsize_t), DIMENSION(1:1,1:4) :: coord + INTEGER(size_t) :: reg_size_start ! Initial amount of regular memory allocated + INTEGER(size_t) :: arr_size_start ! Initial amount of array memory allocated + INTEGER(size_t) :: blk_size_start ! Initial amount of block memory allocated + INTEGER(size_t) :: fac_size_start ! Initial amount of factory memory allocated + INTEGER(size_t) :: reg_size_final ! Final amount of regular memory allocated + INTEGER(size_t) :: arr_size_final ! Final amount of array memory allocated + INTEGER(size_t) :: blk_size_final ! Final amount of BLOCK memory allocated + INTEGER(size_t) :: fac_size_final ! Final amount of factory memory allocated + INTEGER :: error + + coord(1,1:4) = (/3,4,5,6/) + + ! Create dataspace + ! (Allocates array free-list nodes) + CALL h5screate_simple_f(1, dims, sid, error) + CALL CHECK("h5screate_simple_f", error, total_error) + + ! Select sequence of 4 points + CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, 1, 4_size_t, coord, error) + CALL CHECK("h5sselect_elements_f", error, total_error) + + ! Close dataspace + CALL h5sclose_f(sid, error) + CALL CHECK("h5sclose_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_start, arr_size_start, blk_size_start, fac_size_start, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + IF(reg_size_start.LT.0 .OR. & + arr_size_start.LT.0 .OR. & + blk_size_start.LT.0 .OR. & + fac_size_start.LT.0 & + )THEN + CALL check("h5get_free_list_sizes_f", -1, total_error) + ENDIF + + CALL h5garbage_collect_f(error) + CALL check("h5garbage_collect_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_final, arr_size_final, blk_size_final, fac_size_final, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + ! All the free list values should be <= previous values + IF( reg_size_final .GT. reg_size_start) & + CALL check("h5get_free_list_sizes_f: reg_size_final > reg_size_start", -1, total_error) + IF( arr_size_final .GT. arr_size_start) & + CALL check("h5get_free_list_sizes_f: arr_size_final > arr_size_start", -1, total_error) + IF( blk_size_final .GT. blk_size_start) & + CALL check("h5get_free_list_sizes_f: blk_size_final > blk_size_start", -1, total_error) + IF( fac_size_final .GT. fac_size_start) & + CALL check("h5get_free_list_sizes_f: fac_size_final > fac_size_start", -1, total_error) + +END SUBROUTINE test_freelist + END MODULE TH5MISC_1_8 diff --git a/fortran/test/tH5P_F03.F90 b/fortran/test/tH5P_F03.F90 index 606a9cd..4f390d5 100644 --- a/fortran/test/tH5P_F03.F90 +++ b/fortran/test/tH5P_F03.F90 @@ -155,8 +155,6 @@ SUBROUTINE test_create(total_error) fill_ctype%a = 5555. fill_ctype%x = 55 - f_ptr = C_LOC(fill_ctype) - ! Test various fill values CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_CHARACTER, 'X', error) CALL check("H5Pset_fill_value_f",error, total_error) diff --git a/fortran/test/tH5Sselect.F90 b/fortran/test/tH5Sselect.F90 index bf1658c..6dfd7e6 100644 --- a/fortran/test/tH5Sselect.F90 +++ b/fortran/test/tH5Sselect.F90 @@ -126,7 +126,6 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims - ! !This writes data to the HDF5 file. ! @@ -807,6 +806,12 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims + LOGICAL :: same, intersects + INTEGER(HID_T) :: scalar_all_sid + + INTEGER(hsize_t), DIMENSION(1:2) :: block_start = (/0, 0/) ! Start offset for BLOCK + INTEGER(hsize_t), DIMENSION(1:2) :: block_end = (/2, 3/) ! END offset for BLOCK + ! !initialize the coord array to give the selected points' position ! @@ -848,6 +853,22 @@ CONTAINS CALL h5screate_simple_f(RANK, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) + ! Check shape same API + CALL h5sselect_shape_same_f(dataspace, dataspace, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .TRUE., total_error) + + CALL h5screate_f(H5S_SCALAR_F, scalar_all_sid, error) + CALL check("h5screate_f", error, total_error) + + same = .TRUE. + CALL h5sselect_shape_same_f(dataspace, scalar_all_sid, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .FALSE., total_error) + + CALL h5sclose_f(scalar_all_sid,error) + CALL check("h5sclose_f", error, total_error) + ! ! Create the dataset with default properties ! @@ -863,6 +884,33 @@ CONTAINS CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) + ! Set selection to 'all' + CALL h5sselect_all_f(dataspace, error) + CALL check("h5sselect_all_f", error, total_error) + + ! Test block intersection with 'all' selection (always true) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Select 2x2 region of the dataset + CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, offset, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + ! Check an intersecting region + block_start(1:2) = (/1,0/) + block_end(1:2) = (/2,2/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Check a non-intersecting region + block_start(1:2) = (/2,1/) + block_end(1:2) = (/4,5/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f2", intersects, .FALSE., total_error) + ! !Close the dataspace for the dataset. ! @@ -998,6 +1046,9 @@ CONTAINS ! DEALLOCATE(pointlist) + + + ! !Close the dataspace for the dataset. ! diff --git a/fortran/test/tHDF5_F03.F90 b/fortran/test/tHDF5_F03.F90 index dc4da31..1ef7626 100644 --- a/fortran/test/tHDF5_F03.F90 +++ b/fortran/test/tHDF5_F03.F90 @@ -28,7 +28,6 @@ MODULE THDF5_F03 USE TH5_MISC USE TH5E_F03 - USE TH5F_F03 USE TH5L_F03 USE TH5O_F03 USE TH5P_F03 |