diff options
Diffstat (limited to 'fortran/test/tH5F.F90')
| -rw-r--r-- | fortran/test/tH5F.F90 | 2244 |
1 files changed, 1278 insertions, 966 deletions
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 |