diff options
author | Raymond Lu <songyulu@hdfgroup.org> | 2013-03-13 22:34:23 (GMT) |
---|---|---|
committer | Raymond Lu <songyulu@hdfgroup.org> | 2013-03-13 22:34:23 (GMT) |
commit | 08359be858ae9e4595dab1f4a7718017d9af7663 (patch) | |
tree | bbe033fd134cfda5943dff96ef2a7f5f10d743e9 /fortran/test | |
parent | 55822485c64197a6c2c4a623824fcdcd10a57d31 (diff) | |
download | hdf5-08359be858ae9e4595dab1f4a7718017d9af7663.zip hdf5-08359be858ae9e4595dab1f4a7718017d9af7663.tar.gz hdf5-08359be858ae9e4595dab1f4a7718017d9af7663.tar.bz2 |
[svn-r23347] ported revision 23248:23346 from the trunk
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/Makefile.in | 9 | ||||
-rw-r--r-- | fortran/test/fortranlib_test_F03.f90 | 10 | ||||
-rw-r--r-- | fortran/test/tH5F_F03.f90 | 175 | ||||
-rw-r--r-- | fortran/test/tH5P.f90 | 842 | ||||
-rw-r--r-- | fortran/test/tH5P_F03.f90 | 141 | ||||
-rw-r--r-- | fortran/test/tH5T_F03.f90 | 34 |
8 files changed, 774 insertions, 440 deletions
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 5b41a32..5b9ca11 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -105,6 +105,7 @@ IF (HDF5_ENABLE_F2003) fortranlib_test_F03.f90 tH5F.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 42dd127..84f55e5 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -68,7 +68,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ if FORTRAN_2003_CONDITIONAL_F fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 + tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 endif diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index b9f05e3..6c226bc 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -136,11 +136,12 @@ fortranlib_test_1_8_LDADD = $(LDADD) fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ $(LIBH5F) $(LIBHDF5) am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \ - tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 \ - tH5T_F03.f90 + tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 \ + tH5P_F03.f90 tH5T_F03.f90 @FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \ +@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \ @FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \ @@ -304,6 +305,7 @@ H5_VERSION = @H5_VERSION@ HADDR_T = @HADDR_T@ HAVE_DMALLOC = @HAVE_DMALLOC@ HAVE_FORTRAN_2003 = @HAVE_FORTRAN_2003@ +HAVE_PTHREAD = @HAVE_PTHREAD@ HDF5_HL = @HDF5_HL@ HDF5_INTERFACES = @HDF5_INTERFACES@ HDF_CXX = @HDF_CXX@ @@ -355,7 +357,6 @@ PACKAGE_VERSION = @PACKAGE_VERSION@ PARALLEL = @PARALLEL@ PATH_SEPARATOR = @PATH_SEPARATOR@ PERL = @PERL@ -PTHREAD = @PTHREAD@ RANLIB = @RANLIB@ ROOT = @ROOT@ RUNPARALLEL = @RUNPARALLEL@ @@ -527,7 +528,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90 @FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \ -@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 +@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5F_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90 fflush1_SOURCES = fflush1.f90 fflush2_SOURCES = fflush2.f90 diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90 index 606b050..1d9615f 100644 --- a/fortran/test/fortranlib_test_F03.f90 +++ b/fortran/test/fortranlib_test_F03.f90 @@ -145,7 +145,10 @@ PROGRAM fortranlibtest_F03 CALL test_nbit(ret_total_error) CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error) - + ret_total_error = 0 + CALL external_test_offset(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Testing external dataset with offset', total_error) + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing GROUP interface ' @@ -163,6 +166,11 @@ PROGRAM fortranlibtest_F03 CALL 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(*,*) ' ============================================ ' diff --git a/fortran/test/tH5F_F03.f90 b/fortran/test/tH5F_F03.f90 new file mode 100644 index 0000000..dea9a5d --- /dev/null +++ b/fortran/test/tH5F_F03.f90 @@ -0,0 +1,175 @@ +!****h* root/fortran/test/tH5F_F03.f90 +! +! NAME +! tH5F_F03.f90 +! +! FUNCTION +! Test FORTRAN HDF5 H5F APIs which are dependent on FORTRAN 2003 +! features. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! 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 +! ***************************************** + +SUBROUTINE test_get_file_image(total_error) + ! + ! Tests the wrapper for h5fget_file_image + ! + USE HDF5 + USE ISO_C_BINDING + + 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 :: i, file_sz + 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, itmp_b ! General purpose integers + 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 + + + RETURN ! DEBUG, PGI COMPILERS seem to have a bug in the INQUIRE functions, + ! waiting for an answer from PGI how to resolve the problem. + + ! 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) = 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', 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 diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 3faaac2..4c78334 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -27,385 +27,376 @@ ! !***** - SUBROUTINE external_test(cleanup, total_error) +SUBROUTINE external_test(cleanup, total_error) ! This subroutine tests following functionalities: ! h5pset_external_f, h5pget_external_count_f, ! h5pget_external_f - USE HDF5 ! This module contains all necessary modules - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - - CHARACTER(LEN=8), PARAMETER :: filename = "external" - CHARACTER(LEN=80) :: fix_filename - INTEGER(HID_T) :: file_id - INTEGER(HID_T) :: plist_id - INTEGER(HID_T) :: space_id - INTEGER(HID_T) :: dataset_id - INTEGER(HSIZE_T), DIMENSION(1) :: cur_size !data space current size - INTEGER(HSIZE_T), DIMENSION(1) :: max_size !data space maximum size - CHARACTER(LEN=256) :: name !external file name - INTEGER :: file_offset !external file offset - INTEGER(HSIZE_T) :: file_size !sizeof external file segment - INTEGER :: error !error code - INTEGER(SIZE_T) :: int_size !size of integer - INTEGER(HSIZE_T) :: file_bytes !Number of bytes reserved - !in the file for the data - INTEGER :: RANK = 1 !dataset rank - INTEGER :: count !number of external files for the - !specified dataset - INTEGER(SIZE_T) :: namesize - INTEGER(HSIZE_T) :: size, buf_size - INTEGER :: idx - - buf_size = 4*1024*1024 - - ! - !Create file "external.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) - - - CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) - CALL check("h5pcreate_f", error, total_error) - CALL h5pset_buffer_f(plist_id, buf_size, error) - CALL check("h5pset_buffer_f", error, total_error) - CALL h5pget_buffer_f(plist_id, size, error) - CALL check("h5pget_buffer_f", error, total_error) - if (size .ne.buf_size) then - total_error = total_error + 1 - write(*,*) "h5pget_buffer_f returned wrong size, error" - endif - CALL h5pclose_f(plist_id, error) - CALL check("h5pclose_f", error, total_error) - - CALL h5pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) - CALL check("h5pcreate_f",error,total_error) - cur_size(1) =100 - max_size(1) = 100; - call h5tget_size_f(H5T_NATIVE_INTEGER, int_size, error) - CALL check("h5tget_size_f",error,total_error) - file_size = int_size * max_size(1); - CALL h5pset_external_f(plist_id, "ext1.data", 0, file_size, error) - CALL check("h5pset_external_f",error,total_error) - CALL h5screate_simple_f(RANK, cur_size, space_id, error, max_size) - CALL check("h5screate_simple_f", error, total_error) - CALL h5dcreate_f(file_id, "dset1", H5T_NATIVE_INTEGER, space_id, & - dataset_id, error, plist_id) - CALL check("h5dcreate_f", error, total_error) - - CALL h5dclose_f(dataset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5pclose_f(plist_id, error) - CALL check("h5pclose_f", error, total_error) - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - CALL h5fclose_f(file_id, error) - - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) - CALL h5dopen_f(file_id, "dset1", dataset_id, error) - CALL check("h5dopen_f",error,total_error) - - ! Read dataset creation information - CALL h5dget_create_plist_f(dataset_id, plist_id, error) - CALL check("h5dget_create_plist_f",error,total_error) - CALL h5pget_external_count_f(plist_id, count, error) - CALL check("h5pget_external_count_f",error,total_error) - if(count .ne. 1 ) then - write (*,*) "got external_count is not correct" - total_error = total_error + 1 - end if - namesize = 10 - idx = 0 - CALL h5pget_external_f(plist_id, idx, namesize, name, file_offset, & - file_bytes, error) - CALL check("h5pget_external_f",error,total_error) - if(file_offset .ne. 0 ) then - write (*,*) "got external file offset is not correct" - total_error = total_error + 1 - end if - if(file_bytes .ne. file_size ) then - write (*,*) "got external file size is not correct" - total_error = total_error + 1 - end if - - CALL h5dclose_f(dataset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5pclose_f(plist_id, error) - CALL check("h5pclose_f", error, total_error) - 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) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=8), PARAMETER :: filename = "external" + CHARACTER(LEN=80) :: fix_filename + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: plist_id + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: dataset_id + INTEGER(HSIZE_T), DIMENSION(1) :: cur_size !data space current size + INTEGER(HSIZE_T), DIMENSION(1) :: max_size !data space maximum size + CHARACTER(LEN=256) :: name !external file name + INTEGER(OFF_T) :: file_offset !external file offset + INTEGER(HSIZE_T) :: file_size !sizeof external file segment + INTEGER :: error !error code + INTEGER(SIZE_T) :: int_size !size of integer + INTEGER(HSIZE_T) :: file_bytes !Number of bytes reserved + !in the file for the data + INTEGER :: RANK = 1 !dataset rank + INTEGER :: count !number of external files for the + !specified dataset + INTEGER(SIZE_T) :: namesize + INTEGER(HSIZE_T) :: size, buf_size + INTEGER :: idx + + buf_size = 4*1024*1024 + + ! + !Create file "external.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + STOP "Cannot modify filename" + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_buffer_f(plist_id, buf_size, error) + CALL check("h5pset_buffer_f", error, total_error) + CALL h5pget_buffer_f(plist_id, size, error) + CALL check("h5pget_buffer_f", error, total_error) + IF (size .NE.buf_size) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_buffer_f returned wrong size, error" + ENDIF + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) + CALL check("h5pcreate_f",error,total_error) + cur_size(1) =100 + max_size(1) = 100 + CALL h5tget_size_f(H5T_NATIVE_INTEGER, int_size, error) + CALL check("h5tget_size_f",error,total_error) + file_size = int_size * max_size(1) + CALL h5pset_external_f(plist_id, "ext1.data", INT(0,off_t), file_size, error) + CALL check("h5pset_external_f",error,total_error) + CALL h5screate_simple_f(RANK, cur_size, space_id, error, max_size) + CALL check("h5screate_simple_f", error, total_error) + CALL h5dcreate_f(file_id, "dset1", H5T_NATIVE_INTEGER, space_id, & + dataset_id, error, plist_id) + CALL check("h5dcreate_f", error, total_error) + + CALL h5dclose_f(dataset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error) + CALL h5dopen_f(file_id, "dset1", dataset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! Read dataset creation information + CALL h5dget_create_plist_f(dataset_id, plist_id, error) + CALL check("h5dget_create_plist_f",error,total_error) + CALL h5pget_external_count_f(plist_id, count, error) + CALL check("h5pget_external_count_f",error,total_error) + IF(count .NE. 1 ) THEN + WRITE (*,*) "got external_count is not correct" + total_error = total_error + 1 + END IF + namesize = 10 + idx = 0 + CALL h5pget_external_f(plist_id, idx, namesize, name, file_offset, & + file_bytes, error) + CALL check("h5pget_external_f",error,total_error) + IF(file_offset .NE. 0 ) THEN + WRITE (*,*) "got external file offset is not correct" + total_error = total_error + 1 + END IF + IF(file_bytes .NE. file_size ) THEN + WRITE (*,*) "got external file size is not correct" + total_error = total_error + 1 + END IF + + CALL h5dclose_f(dataset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + 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 external_test + +SUBROUTINE multi_file_test(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=9), PARAMETER :: filename = "multidset" ! File name + CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dspace_id ! Dataspace identifier + INTEGER(HID_T) :: dtype_id ! Datatype identifier + INTEGER(HID_T) :: fapl, fapl_1 ! File access property list identifier + INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_map, memb_map_out + INTEGER(HID_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_fapl, memb_fapl_out + CHARACTER(LEN=20), DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_name, memb_name_out + REAL, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_addr, memb_addr_out + !INTEGER(HADDR_T), DIMENSION(0:H5FD_MEM_NTYPES_F) :: memb_addr + LOGICAL :: relax = .TRUE. + LOGICAL :: relax_out = .TRUE. + + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions + INTEGER :: rank = 2 ! Dataset rank + + INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers + INTEGER :: error ! Error flag + INTEGER(HID_T) :: driver + INTEGER :: i, j !general purpose integers + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER :: mdc_nelmts + INTEGER(SIZE_T) :: rdcc_nelmts + INTEGER(SIZE_T) :: rdcc_nbytes + REAL :: rdcc_w0 + memb_fapl = H5P_DEFAULT_F + memb_map = H5FD_MEM_SUPER_F + memb_addr = 0. + memb_map(H5FD_MEM_SUPER_F) = H5FD_MEM_SUPER_F + memb_addr(H5FD_MEM_SUPER_F) = 0. + memb_map(H5FD_MEM_BTREE_F) = H5FD_MEM_BTREE_F + memb_addr(H5FD_MEM_BTREE_F) = 0.1 + memb_map(H5FD_MEM_DRAW_F) = H5FD_MEM_DRAW_F + memb_addr(H5FD_MEM_DRAW_F) = 0.5 + memb_map(H5FD_MEM_GHEAP_F) = H5FD_MEM_GHEAP_F + memb_addr(H5FD_MEM_GHEAP_F) = 0.2 + memb_map(H5FD_MEM_LHEAP_F) = H5FD_MEM_LHEAP_F + memb_addr(H5FD_MEM_LHEAP_F) = 0.3 + memb_map(H5FD_MEM_OHDR_F) = H5FD_MEM_OHDR_F + memb_addr(H5FD_MEM_OHDR_F) = 0.4 + + memb_name = ' ' + memb_name(H5FD_MEM_SUPER_F) = '%s-s.h5' + memb_name(H5FD_MEM_BTREE_F) = '%s-b.h5' + memb_name(H5FD_MEM_DRAW_F) = '%s-r.h5' + memb_name(H5FD_MEM_GHEAP_F) = '%s-g.h5' + memb_name(H5FD_MEM_LHEAP_F) = '%s-l.h5' + memb_name(H5FD_MEM_OHDR_F) = '%s-o.h5' + + ! + ! Initialize the dset_data array. + ! + DO i = 1, 4 + DO j = 1, 6 + dset_data(i,j) = (i-1)*6 + j + END DO + END DO + + ! + ! 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_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_fapl_multi_f(fapl, memb_map, memb_fapl, memb_name, memb_addr, relax, error) + CALL check("h5pset_fapl_multi_f", error, total_error) + CALL h5pget_fapl_multi_f(fapl, memb_map_out, memb_fapl_out, memb_name_out, & + memb_addr_out, relax_out, error) + CALL check("h5pget_fapl_multi_f", error, total_error) + CALL h5pget_driver_f(fapl, driver, error) + CALL check("h5pget_driver_f",error, total_error) + IF(driver .NE. H5FD_MULTI_F) THEN + WRITE(*,*) "Wrong value for driver" + ENDIF + ! + ! Let's check h5pget(set)cache_f APIs here for now + ! + CALL h5pget_cache_f(fapl, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, & + rdcc_w0, error) + CALL check("h5pget_cache_f", error, total_error) + + ! + ! Set cache to some number + ! + rdcc_nbytes = 1024*1024 + CALL h5pset_cache_f(fapl, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, & + rdcc_w0, error) + CALL check("h5pset_cache_f", error, total_error) + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error, access_prp = fapl) + CALL check("h5fcreate_f", error, total_error) + IF(error .NE. 0) THEN + WRITE(*,*) "Cannot create file using multi-file driver... Exiting...." + total_error = 1 + CALL h5pclose_f(fapl, error) RETURN - END SUBROUTINE external_test - - SUBROUTINE multi_file_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - - CHARACTER(LEN=9), PARAMETER :: filename = "multidset" ! File name - CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dspace_id ! Dataspace identifier - INTEGER(HID_T) :: dtype_id ! Datatype identifier - INTEGER(HID_T) :: fapl, fapl_1 ! File access property list identifier - INTEGER, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_map, memb_map_out - INTEGER(HID_T), DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_fapl, memb_fapl_out - CHARACTER(LEN=20), DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_name, memb_name_out - REAL, DIMENSION(0:H5FD_MEM_NTYPES_F-1) :: memb_addr, memb_addr_out - !INTEGER(HADDR_T), DIMENSION(0:H5FD_MEM_NTYPES_F) :: memb_addr - LOGICAL :: relax = .TRUE. - LOGICAL :: relax_out = .TRUE. - - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions - INTEGER :: rank = 2 ! Dataset rank - - INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers - INTEGER :: error ! Error flag - INTEGER(HID_T) :: driver - INTEGER :: i, j !general purpose integers - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - INTEGER :: mdc_nelmts - INTEGER(SIZE_T) :: rdcc_nelmts - INTEGER(SIZE_T) :: rdcc_nbytes - REAL :: rdcc_w0 - memb_fapl = H5P_DEFAULT_F - memb_map = H5FD_MEM_SUPER_F - memb_addr = 0. - memb_map(H5FD_MEM_SUPER_F) = H5FD_MEM_SUPER_F - memb_addr(H5FD_MEM_SUPER_F) = 0. - memb_map(H5FD_MEM_BTREE_F) = H5FD_MEM_BTREE_F - memb_addr(H5FD_MEM_BTREE_F) = 0.1 - memb_map(H5FD_MEM_DRAW_F) = H5FD_MEM_DRAW_F - memb_addr(H5FD_MEM_DRAW_F) = 0.5 - memb_map(H5FD_MEM_GHEAP_F) = H5FD_MEM_GHEAP_F - memb_addr(H5FD_MEM_GHEAP_F) = 0.2 - memb_map(H5FD_MEM_LHEAP_F) = H5FD_MEM_LHEAP_F - memb_addr(H5FD_MEM_LHEAP_F) = 0.3 - memb_map(H5FD_MEM_OHDR_F) = H5FD_MEM_OHDR_F - memb_addr(H5FD_MEM_OHDR_F) = 0.4 - - memb_name = ' ' - memb_name(H5FD_MEM_SUPER_F) = '%s-s.h5' - memb_name(H5FD_MEM_BTREE_F) = '%s-b.h5' - memb_name(H5FD_MEM_DRAW_F) = '%s-r.h5' - memb_name(H5FD_MEM_GHEAP_F) = '%s-g.h5' - memb_name(H5FD_MEM_LHEAP_F) = '%s-l.h5' - memb_name(H5FD_MEM_OHDR_F) = '%s-o.h5' - - ! - ! Initialize the dset_data array. - ! - do i = 1, 4 - do j = 1, 6 - dset_data(i,j) = (i-1)*6 + j; - end do - end do - - ! - ! 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_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f", error, total_error) - CALL h5pset_fapl_multi_f(fapl, memb_map, memb_fapl, memb_name, memb_addr, relax, error) - CALL check("h5pset_fapl_multi_f", error, total_error) - CALL h5pget_fapl_multi_f(fapl, memb_map_out, memb_fapl_out, memb_name_out, & - memb_addr_out, relax_out, error) - CALL check("h5pget_fapl_multi_f", error, total_error) - CALL h5pget_driver_f(fapl, driver, error) - CALL check("h5pget_driver_f",error, total_error) - if(driver .ne. H5FD_MULTI_F) then - write(*,*) "Wrong value for driver" - endif - ! - ! Let's check h5pget(set)cache_f APIs here for now - ! - CALL h5pget_cache_f(fapl, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, & - rdcc_w0, error) - CALL check("h5pget_cache_f", error, total_error) - - - ! Set cache to some number - ! - rdcc_nbytes = 1024*1024 - CALL h5pset_cache_f(fapl, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, & - rdcc_w0, error) - CALL check("h5pset_cache_f", error, total_error) - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error, access_prp = fapl) - CALL check("h5fcreate_f", error, total_error) - if(error .ne. 0) then - write(*,*) "Cannot create file using multi-file driver... Exiting...." - total_error = 1 - call h5pclose_f(fapl, error) - return - endif - - ! - ! Create the dataspace. - ! - CALL h5screate_simple_f(rank, dims, dspace_id, error) - CALL check("h5screate_simple_f", error, total_error) - - - ! - ! Create the dataset with default properties. - ! - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & - dset_id, error) - CALL check("h5dcreate_f", error, total_error) - - ! - ! Write the dataset. - ! - data_dims(1) = 4 - data_dims(2) = 6 - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) - CALL check("h5dwrite_f", error, total_error) - - - ! - ! End access to the dataset and release resources used by it. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - - ! - ! Terminate access to the data space. - ! - CALL h5sclose_f(dspace_id, error) - CALL check("h5sclose_f", error, total_error) - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) - CALL h5pclose_f(fapl, error) - CALL check("h5pclose_f", error, total_error) - ! - ! Open the existing file. - ! - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f", error, total_error) - CALL h5pset_fapl_multi_f(fapl, relax, error) - CALL check("h5pset_fapl_multi_f", error, total_error) - CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error, access_prp = fapl) - CALL check("h5fopen_f", error, total_error) - ! - CALL h5fget_access_plist_f(file_id, fapl_1, error) - CALL check("h5fget_access_plist_f", error, total_error) - !It doesn't work on Windows. - !CALL h5pget_fapl_multi_f(fapl_1, memb_map_out, memb_fapl_out, memb_name_out, & - ! memb_addr_out, relax_out, error) - ! write(*,*) memb_map_out - ! write(*,*) memb_fapl_out - ! write(*,*) memb_name_out - ! write(*,*) memb_addr_out - ! CALL check("h5pget_fapl_multi_f", error, total_error) - - ! - ! Open the existing dataset. - ! - CALL h5dopen_f(file_id, dsetname, dset_id, error) - CALL check("h5dopen_f", error, total_error) - - ! - ! Get the dataset type. - ! - CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f", error, total_error) - - ! - ! Get the data space. - ! - CALL h5dget_space_f(dset_id, dspace_id, error) - CALL check("h5dget_space_f", error, total_error) - - ! - ! Read the dataset. - ! - CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) - CALL check("h5dread_f", error, total_error) - - ! - !Compare the data. - ! - do i = 1, 4 - do j = 1, 6 - IF (data_out(i,j) .NE. dset_data(i, j)) THEN - write(*, *) "dataset test error occured" - write(*,*) "data read is not the same as the data writen" - END IF - end do - end do - - ! - ! End access to the dataset and release resources used by it. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - - ! - ! Terminate access to the data space. - ! - CALL h5sclose_f(dspace_id, error) - CALL check("h5sclose_f", error, total_error) - - ! - ! Terminate access to the data type. - ! - CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f", error, total_error) - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) - CALL h5pclose_f(fapl, error) - CALL check("h5pclose_f", error, total_error) - CALL h5pclose_f(fapl_1, error) - CALL check("h5pclose_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-b', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-g', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-l', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-o', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-r', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - IF(cleanup) CALL h5_cleanup_f(filename//'.h5-s', H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - - RETURN - END SUBROUTINE multi_file_test + ENDIF + ! + ! Create the dataspace. + ! + CALL h5screate_simple_f(rank, dims, dspace_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! Create the dataset with default properties. + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & + dset_id, error) + CALL check("h5dcreate_f", error, total_error) + ! + ! Write the dataset. + ! + data_dims(1) = 4 + data_dims(2) = 6 + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) + CALL check("h5dwrite_f", error, total_error) + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + CALL h5pclose_f(fapl, error) + CALL check("h5pclose_f", error, total_error) + ! + ! Open the existing file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_fapl_multi_f(fapl, relax, error) + CALL check("h5pset_fapl_multi_f", error, total_error) + CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error, access_prp = fapl) + CALL check("h5fopen_f", error, total_error) + ! + CALL h5fget_access_plist_f(file_id, fapl_1, error) + CALL check("h5fget_access_plist_f", error, total_error) + !It doesn't work on Windows. + !CALL h5pget_fapl_multi_f(fapl_1, memb_map_out, memb_fapl_out, memb_name_out, & + ! memb_addr_out, relax_out, error) + ! write(*,*) memb_map_out + ! write(*,*) memb_fapl_out + ! write(*,*) memb_name_out + ! write(*,*) memb_addr_out + ! CALL check("h5pget_fapl_multi_f", error, total_error) + + ! + ! Open the existing dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + ! Get the dataset type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f", error, total_error) + + ! + ! Get the data space. + ! + CALL h5dget_space_f(dset_id, dspace_id, error) + CALL check("h5dget_space_f", error, total_error) + + ! + ! Read the dataset. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) + CALL check("h5dread_f", error, total_error) + + ! + !Compare the data. + ! + DO i = 1, 4 + DO j = 1, 6 + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + WRITE(*, *) "dataset test error occured" + WRITE(*,*) "data read is not the same as the data writen" + END IF + END DO + END DO + + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + + ! + ! Terminate access to the data type. + ! + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f", error, total_error) + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + CALL h5pclose_f(fapl, error) + CALL check("h5pclose_f", error, total_error) + CALL h5pclose_f(fapl_1, error) + CALL check("h5pclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-b', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-g', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-l', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-o', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-r', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename//'.h5-s', H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + RETURN +END SUBROUTINE multi_file_test !------------------------------------------------------------------------- ! Function: test_chunk_cache @@ -432,24 +423,24 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error - + CHARACTER(LEN=14), PARAMETER :: filename="chunk_cache" CHARACTER(LEN=80) :: fix_filename - INTEGER(hid_t) :: fid = -1 ! /* File ID */ + INTEGER(hid_t) :: fid = -1 ! File ID INTEGER(hid_t) :: file - INTEGER(hid_t) :: fapl_local = -1 ! /* Local fapl */ - INTEGER(hid_t) :: fapl_def = -1 ! /* Default fapl */ - INTEGER(hid_t) :: dcpl = -1 !/* Dataset creation property list ID */ - INTEGER(hid_t) :: dapl1 = -1 !/* Dataset access property list ID */ - INTEGER(hid_t) :: dapl2 = -1 !/* Dataset access property list ID */ - INTEGER(hid_t) :: sid = -1 !/* Dataspace ID */ - INTEGER(hid_t) :: dsid = -1 !/* Dataset ID */ - INTEGER(hsize_t), DIMENSION(1:1) :: chunk_dim, NDIM = (/100/) !/* Dataset and chunk dimensions */ - INTEGER(size_t) :: nslots_1, nslots_2, nslots_3, nslots_4 !/* rdcc number of elements */ - INTEGER(size_t) :: nbytes_1, nbytes_2, nbytes_3, nbytes_4 !/* rdcc number of bytes */ + INTEGER(hid_t) :: fapl_local = -1 ! Local fapl + INTEGER(hid_t) :: fapl_def = -1 ! Default fapl + INTEGER(hid_t) :: dcpl = -1 ! Dataset creation property list ID + INTEGER(hid_t) :: dapl1 = -1 ! Dataset access property list ID + INTEGER(hid_t) :: dapl2 = -1 ! Dataset access property list ID + INTEGER(hid_t) :: sid = -1 ! Dataspace ID + INTEGER(hid_t) :: dsid = -1 ! Dataset ID + INTEGER(hsize_t), DIMENSION(1:1) :: chunk_dim, NDIM = (/100/) ! Dataset and chunk dimensions + INTEGER(size_t) :: nslots_1, nslots_2, nslots_3, nslots_4 ! rdcc number of elements + INTEGER(size_t) :: nbytes_1, nbytes_2, nbytes_3, nbytes_4 ! rdcc number of bytes INTEGER :: mdc_nelmts - INTEGER(size_t) ::nlinks !/* Number of link traversals */ - REAL :: w0_1, w0_2, w0_3, w0_4; !/* rdcc preemption policy */ + INTEGER(size_t) ::nlinks ! Number of link traversals + REAL :: w0_1, w0_2, w0_3, w0_4 ! rdcc preemption policy INTEGER :: error INTEGER(size_t) rdcc_nelmts INTEGER(size_t) rdcc_nbytes @@ -462,7 +453,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) STOP ENDIF - !/* Create a default fapl and dapl */ + ! Create a default fapl and dapl CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl_def, error) CALL check("H5Pcreate_f", error, total_error) CALL H5Pcreate_f(H5P_DATASET_ACCESS_F, dapl1, error) @@ -481,7 +472,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF - ! /* Set a lapl property on dapl1 (to verify inheritance) */ + ! Set a lapl property on dapl1 (to verify inheritance) CALL H5Pset_nlinks_f(dapl1, 134_size_t , error) CALL check("H5Pset_nlinks_f", error, total_error) CALL H5Pget_nlinks_f(dapl1, nlinks, error) @@ -494,7 +485,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Turn off the chunk cache, so all the chunks are immediately written to disk CALL H5Pget_cache_f(fapl_local, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, error) CALL check("H5Pget_cache_f", error, total_error) - rdcc_nbytes = 0; + rdcc_nbytes = 0 CALL H5Pset_cache_f(fapl_local, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, error) CALL check("H5Pset_cache_f", error, total_error) @@ -506,29 +497,29 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Pset_cache_f(fapl_local, 0, nslots_2, nbytes_2, w0_2, error) CALL check("H5Pset_cache_f", error, total_error) - !/* Create file */ + ! Create file CALL H5Fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl_local) CALL check("H5Fcreate_f", error, total_error) - !/* Create dataset creation property list */ + ! Create dataset creation property list CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) CALL check("H5Pcreate_f", error, total_error) - !/* Set chunking */ - chunk_dim(1) = 10; + ! Set chunking + chunk_dim(1) = 10 CALL H5Pset_chunk_f(dcpl, 1, chunk_dim, error) CALL check("H5Pset_chunk_f", error, total_error) - !/* Create 1-D dataspace */ + ! Create 1-D dataspace ndim(1) = 100 CALL H5Screate_simple_f(1, ndim, sid, error) CALL check("H5Pcreate_f", error, total_error) - ! /* Create dataset with default dapl */ + ! Create dataset with default dapl CALL H5Dcreate_f(fid, "dset", H5T_NATIVE_INTEGER, sid, dsid, error, dcpl, H5P_DEFAULT_F, dapl1) CALL check("H5Pcreate_f", error, total_error) - ! /* Retrieve dapl from dataset, verify cache values are the same as on fapl_local */ + ! Retrieve dapl from dataset, verify cache values are the same as on fapl_local CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error) @@ -538,7 +529,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) IF(w0_2.NE.w0_4)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) ! Set new values on dapl1. nbytes will be set to default, so the file ! property will override this setting @@ -550,7 +542,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Pset_chunk_cache_f(dapl1, nslots_3, nbytes_3, w0_3, error) CALL check("H5Pset_chunk_cache_f", error, total_error) - ! Close dataset, reopen with dapl1. Note the use of a dapl with H5Oopen */ + ! Close dataset, reopen with dapl1. Note the use of a dapl with H5Oopen CALL H5Dclose_f(dsid, error) CALL H5Oopen_f(fid, "dset", dsid, error, dapl1) @@ -569,10 +561,12 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) IF(w0_3.NE.w0_4)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error) ENDIF - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) ! Close dataset, reopen with H5P_DEFAULT as dapl - CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) + CALL H5Dclose_f(dsid, error) + CALL check("H5Dclose_f", error, total_error) CALL H5Oopen_f(fid, "dset", dsid, error) CALL check("H5Oopen_f", error, total_error) @@ -587,10 +581,12 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) IF(w0_2.NE.w0_4)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) ! Similary, test use of H5Dcreate2 with H5P_DEFAULT - CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) + CALL H5Dclose_f(dsid, error) + CALL check("H5Dclose_f", error, total_error) CALL H5Dcreate_f(fid, "dset2", H5T_NATIVE_INTEGER, sid, dsid, error, dcpl, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("H5Pcreate_f", error, total_error) @@ -615,8 +611,10 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Close and reopen file with new fapl_local - CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) - CALL H5Fclose_f(fid,error); CALL check("h5fclose_f", error, total_error) + CALL H5Dclose_f(dsid, error) + CALL check("H5Dclose_f", error, total_error) + CALL H5Fclose_f(fid,error) + CALL check("h5fclose_f", error, total_error) CALL H5Fopen_f (fix_filename, H5F_ACC_RDWR_F, fid, error, fapl_local) CALL check("h5fopen_f", error, total_error) @@ -628,7 +626,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL h5dopen_f (fid, "dset", dsid, error, dapl2) CALL check("h5dopen_f", error, total_error) - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) ! Close dapl2, to avoid id leak + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) ! Close dapl2, to avoid id leak CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) @@ -647,11 +646,13 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL H5Pset_chunk_cache_f(dapl2, nslots_2, nbytes_2, w0_2, error) CALL check("H5Pset_chunk_cache_f", error, total_error) - CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) + CALL H5Dclose_f(dsid, error) + CALL check("H5Dclose_f", error, total_error) CALL h5dopen_f (fid, "dset", dsid, error, dapl2) CALL check("h5dopen_f", error, total_error) - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) @@ -665,17 +666,24 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Close - CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) - CALL H5Sclose_f(sid,error); CALL check("H5Sclose_f", error, total_error) - CALL H5Pclose_f(fapl_local,error); CALL check("H5Pclose_f", error, total_error) - CALL H5Pclose_f(fapl_def,error); CALL check("H5Pclose_f", error, total_error) - CALL H5Pclose_f(dapl1,error); CALL check("H5Pclose_f", error, total_error) - CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) - CALL H5Pclose_f(dcpl,error); CALL check("H5Pclose_f", error, total_error) - CALL H5Fclose_f(fid,error); CALL check("H5Fclose_f", error, total_error) + CALL H5Dclose_f(dsid, error) + CALL check("H5Dclose_f", error, total_error) + CALL H5Sclose_f(sid,error) + CALL check("H5Sclose_f", error, total_error) + CALL H5Pclose_f(fapl_local,error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(fapl_def,error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl1,error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dapl2,error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(dcpl,error) + CALL check("H5Pclose_f", error, total_error) + 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) END SUBROUTINE test_chunk_cache - diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index aec8a26..02ca9dc 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -362,3 +362,144 @@ SUBROUTINE test_genprop_class_callback(total_error) CALL check("h5pclose_class_f", error, total_error) END SUBROUTINE test_genprop_class_callback + +!------------------------------------------------------------------------- +! Function: external_test_offset +! +! Purpose: Tests APIs: +! h5pset_external_f (with offsets not equal to zero), h5pget_external_f +! +! Return: Success: 0 +! Failure: -1 +! +! FORTRAN Programmer: M. Scot Breitenfeld +! January 10, 2012 +!------------------------------------------------------------------------- +! +SUBROUTINE external_test_offset(cleanup,total_error) + + USE ISO_C_BINDING + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + LOGICAL, INTENT(IN) :: cleanup + + INTEGER(hid_t) :: fapl=-1 ! file access property list + INTEGER(hid_t) :: file=-1 ! file to write to + INTEGER(hid_t) :: dcpl=-1 ! dataset creation properties + INTEGER(hid_t) :: space=-1 ! data space + INTEGER(hid_t) :: dset=-1 ! dataset + INTEGER(hid_t) :: grp=-1 ! group to emit diagnostics + INTEGER(size_t) :: i, j ! miscellaneous counters + CHARACTER(LEN=180) :: filename ! file names + INTEGER, DIMENSION(1:25) :: part ! raw data buffers + INTEGER, DIMENSION(1:100), TARGET :: whole ! raw data buffers + INTEGER(hsize_t), DIMENSION(1:1) :: cur_size ! current data space size + INTEGER(hid_t) :: hs_space ! hyperslab data space + INTEGER(hsize_t), DIMENSION(1:1) :: hs_start = (/30/) ! hyperslab starting offset + INTEGER(hsize_t), DIMENSION(1:1) :: hs_count = (/25/) ! hyperslab size + CHARACTER(LEN=1) :: ichr1 ! character conversion holder + INTEGER :: error ! error status + TYPE(C_PTR) :: f_ptr ! fortran pointer + + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:30) :: temparray + + temparray(1:30)(1:1) = '0' ! 1 byte character + + ! Write the data to external files directly + DO i = 1, 4 + DO j = 1, 25 + part(j) = (i-1)*25+(j-1) + ENDDO + WRITE(ichr1,'(I1.1)') i + filename = "extern_"//ichr1//"a.raw" + OPEN(10, FILE=filename, ACCESS='STREAM', form='UNFORMATTED') + + WRITE(10) temparray(1:(i-1)*10) + WRITE(10) part + CLOSE(10) + ENDDO + ! + ! Create the file and an initial group. + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL h5fcreate_f('extren_raw.h5', H5F_ACC_TRUNC_F, file, error, access_prp=fapl) + CALL check("h5fcreate_f",error,total_error) + + CALL h5gcreate_f(file, "emit-diagnostics", grp, error) + CALL check("h5gcreate_f",error, total_error) + + ! Create the dataset + CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_external_f(dcpl, "extern_1a.raw", INT(0,off_t), INT(SIZEOF(part), hsize_t), error) + CALL check("h5pset_external_f",error,total_error) + CALL h5pset_external_f(dcpl, "extern_2a.raw", INT(10,off_t), INT(SIZEOF(part), hsize_t), error) + CALL check("h5pset_external_f",error,total_error) + CALL h5pset_external_f(dcpl, "extern_3a.raw", INT(20,off_t), INT(SIZEOF(part), hsize_t), error) + CALL check("h5pset_external_f",error,total_error) + CALL h5pset_external_f(dcpl, "extern_4a.raw", INT(30,off_t), INT(SIZEOF(part), hsize_t), error) + CALL check("h5pset_external_f",error,total_error) + + cur_size(1) = 100 + CALL h5screate_simple_f(1, cur_size, space, error) + CALL check("h5screate_simple_f", error, total_error) + CALL h5dcreate_f(file, "dset1", H5T_NATIVE_INTEGER, space, dset,error,dcpl_id=dcpl) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Read the entire dataset and compare with the original + whole(:) = 0 + f_ptr = C_LOC(whole(1)) + CALL h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, error, mem_space_id=space, file_space_id=space) + CALL check("h5dread_f", error, total_error) + + DO i = 1, 100 + IF(whole(i) .NE. i-1)THEN + WRITE(*,*) "Incorrect value(s) read." + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + ! + ! Read the middle of the dataset + CALL h5scopy_f(space, hs_space, error) + CALL check("h5scopy_f", error, total_error) + CALL h5sselect_hyperslab_f(hs_space, H5S_SELECT_SET_F, hs_start, hs_count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + whole(:) = 0 + f_ptr = C_LOC(whole(1)) + CALL h5dread_f(dset, H5T_NATIVE_INTEGER, f_ptr, error, mem_space_id=hs_space, file_space_id=hs_space) + CALL check("h5dread_f", error, total_error) + + CALL h5sclose_f(hs_space, error) + CALL check("h5sclose_f", error, total_error) + DO i = hs_start(1)+1, hs_start(1)+hs_count(1) + IF(whole(i) .NE. i-1)THEN + WRITE(*,*) "Incorrect value(s) read." + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + CALL h5dclose_f(dset, error) + CALL check("h5dclose_f", error, total_error) + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f", error, total_error) + CALL h5sclose_f(space, error) + CALL check("h5sclose_f", error, total_error) + CALL h5fclose_f(file, error) + CALL check("h5fclose_f", error, total_error) + + ! cleanup + DO i = 1, 4 + WRITE(ichr1,'(I1.1)') i + filename = "extern_"//ichr1//"a.raw" + CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + ENDDO + IF(cleanup) CALL h5_cleanup_f("extren_raw.h5", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + +END SUBROUTINE external_test_offset diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index 7336cf7..f7efcc4 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -405,7 +405,7 @@ END SUBROUTINE test_array_compound_atomic CALL check("h5tarray_create_f", error, total_error) ! Insert character array field - CALL h5tinsert_f(tid2, "c", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1))), tid4, error) + CALL h5tinsert_f(tid2, "c", H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1))), tid4, error) CALL check("h5tinsert2_f", error, total_error) ! Close array of floats field datatype @@ -551,7 +551,7 @@ END SUBROUTINE test_array_compound_atomic CALL H5Tget_member_offset_f(tid2, 2, off, error) CALL check("H5Tget_member_offset_f", error, total_error) CALL VERIFY("H5Tget_member_offset_f",INT(off),& - INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)))), total_error) + INT(H5OFFSETOF(C_LOC(wdata(1,1)),C_LOC(wdata(1,1)%c(1)(1:1)))), total_error) ! Check the 3rd field's datatype CALL H5Tget_member_type_f(tid2, 2, mtid2, error) @@ -1710,7 +1710,7 @@ SUBROUTINE t_opaque(total_error) ! CALL h5dcreate_f(file, dataset, dtype, space, dset, error) CALL check("h5dcreate_f",error, total_error) - f_ptr = C_LOC(wdata(1)) + f_ptr = C_LOC(wdata(1)(1:1)) CALL h5dwrite_f(dset, dtype, f_ptr, error) CALL check("h5dwrite_f",error, total_error) ! @@ -1774,7 +1774,7 @@ SUBROUTINE t_opaque(total_error) ! ! Read the data. ! - f_ptr = C_LOC(rdata(1)) + f_ptr = C_LOC(rdata(1)(1:1)) CALL h5dread_f(dset, dtype, f_ptr, error) CALL check("H5Dread_f",error, total_error) ! @@ -2123,7 +2123,7 @@ SUBROUTINE t_regref(total_error) CALL h5screate_simple_f(1, dims3, memspace, error) CALL check("h5screate_simple_f",error, total_error) - f_ptr = C_LOC(rdata2(1)) + f_ptr = C_LOC(rdata2(1)(1:1)) CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space) CALL check("H5Dread_f",error, total_error) CALL verifystring("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error) @@ -2473,24 +2473,24 @@ SUBROUTINE t_vlstring_readwrite(total_error) ! Initialize array of C pointers - wdata(1) = C_LOC(A(1)) - wdata(2) = C_LOC(B(1)) - wdata(3) = C_LOC(C(1)) - wdata(4) = C_LOC(D(1)) + wdata(1) = C_LOC(A(1)(1:1)) + wdata(2) = C_LOC(B(1)(1:1)) + wdata(3) = C_LOC(C(1)(1:1)) + wdata(4) = C_LOC(D(1)(1:1)) data_w(1) = A(1) data_w(2) = B(1) data_w(3) = C(1) data_w(4) = D(1) - wdata2D(1,1) = C_LOC(A11(1)) - wdata2D(1,2) = C_LOC(A12(1)) - wdata2D(1,3) = C_LOC(A13(1)) - wdata2D(1,4) = C_LOC(A14(1)) - wdata2D(2,1) = C_LOC(A21(1)) - wdata2D(2,2) = C_LOC(A22(1)) - wdata2D(2,3) = C_LOC(A23(1)) - wdata2D(2,4) = C_LOC(A24(1)) + wdata2D(1,1) = C_LOC(A11(1)(1:1)) + wdata2D(1,2) = C_LOC(A12(1)(1:1)) + wdata2D(1,3) = C_LOC(A13(1)(1:1)) + wdata2D(1,4) = C_LOC(A14(1)(1:1)) + wdata2D(2,1) = C_LOC(A21(1)(1:1)) + wdata2D(2,2) = C_LOC(A22(1)(1:1)) + wdata2D(2,3) = C_LOC(A23(1)(1:1)) + wdata2D(2,4) = C_LOC(A24(1)(1:1)) data2D_w(1,1) = A11(1) data2D_w(1,2) = A12(1) |