diff options
Diffstat (limited to 'fortran/test')
-rw-r--r-- | fortran/test/fflush1.f90 | 48 | ||||
-rw-r--r-- | fortran/test/fflush2.f90 | 42 | ||||
-rw-r--r-- | fortran/test/fortranlib_test.f90 | 30 | ||||
-rw-r--r-- | fortran/test/fortranlib_test_1_8.f90 | 50 | ||||
-rw-r--r-- | fortran/test/t.c | 4 | ||||
-rw-r--r-- | fortran/test/tH5A.f90 | 150 | ||||
-rw-r--r-- | fortran/test/tH5A_1_8.f90 | 298 | ||||
-rw-r--r-- | fortran/test/tH5D.f90 | 110 | ||||
-rw-r--r-- | fortran/test/tH5E.f90 | 24 | ||||
-rw-r--r-- | fortran/test/tH5F.f90 | 178 | ||||
-rw-r--r-- | fortran/test/tH5G.f90 | 86 | ||||
-rw-r--r-- | fortran/test/tH5G_1_8.f90 | 192 | ||||
-rw-r--r-- | fortran/test/tH5I.f90 | 76 | ||||
-rw-r--r-- | fortran/test/tH5O.f90 | 56 | ||||
-rw-r--r-- | fortran/test/tH5P.f90 | 122 | ||||
-rw-r--r-- | fortran/test/tH5R.f90 | 180 | ||||
-rw-r--r-- | fortran/test/tH5S.f90 | 92 | ||||
-rw-r--r-- | fortran/test/tH5Sselect.f90 | 330 | ||||
-rw-r--r-- | fortran/test/tH5T.f90 | 168 | ||||
-rw-r--r-- | fortran/test/tH5VL.f90 | 126 | ||||
-rw-r--r-- | fortran/test/tH5Z.f90 | 92 | ||||
-rw-r--r-- | fortran/test/tf.f90 | 104 |
22 files changed, 1279 insertions, 1279 deletions
diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90 index f42ae6e..8767e55 100644 --- a/fortran/test/fflush1.f90 +++ b/fortran/test/fflush1.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,23 +11,23 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! ! Purpose: This is the first half of a two-part test that makes sure ! that a file can be read after an application crashes as long -! as the file was flushed first. We simulate by exit the +! as the file was flushed first. We simulate by exit the ! the program using stop statement ! PROGRAM FFLUSH1EXAMPLE - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE ! - !the respective filename is "fflush1.h5" + !the respective filename is "fflush1.h5" ! CHARACTER(LEN=7), PARAMETER :: filename = "fflush1" CHARACTER(LEN=80) :: fix_filename @@ -42,40 +42,40 @@ ! ! File identifiers ! - INTEGER(HID_T) :: file_id - + INTEGER(HID_T) :: file_id + ! ! Group identifier ! - INTEGER(HID_T) :: gid + INTEGER(HID_T) :: gid ! ! dataset identifier ! INTEGER(HID_T) :: dset_id - + ! ! 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 - ! + !flag to check operation success + ! INTEGER :: error ! - !general purpose integer - ! + !general purpose integer + ! INTEGER :: i, j, total_error = 0 ! - !data buffers - ! + !data buffers + ! INTEGER, DIMENSION(NX,NY) :: data_in INTEGER(HSIZE_T), DIMENSION(2) :: data_dims data_dims(1) = NX @@ -84,7 +84,7 @@ ! !Initialize FORTRAN predifined datatypes ! - CALL h5open_f(error) + CALL h5open_f(error) CALL check("h5open_f",error,total_error) ! @@ -98,7 +98,7 @@ ! !Create file "fflush1.h5" using default properties. - ! + ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" @@ -109,29 +109,29 @@ ! !Create group "/G" inside file "fflush1.h5". - ! + ! CALL h5gcreate_f(file_id, "/G", gid, error) CALL check("h5gcreate_f",error,total_error) ! - !Create data space for the dataset. + !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 "fflush1.h5". - ! + ! CALL h5dcreate_f(file_id, "/D", H5T_NATIVE_INTEGER, dataspace, & dset_id, error) CALL check("h5dcreate_f",error,total_error) - + ! ! Write data_in to the dataset ! CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) CALL check("h5dwrite_f",error,total_error) - + ! !flush and exit without closing the library ! diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90 index 38a2bd7..a4710e2 100644 --- a/fortran/test/fflush2.f90 +++ b/fortran/test/fflush2.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,7 +11,7 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! ! Purpose: This is the second half of a two-part test that makes sure @@ -22,8 +22,8 @@ PROGRAM FFLUSH2EXAMPLE - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE CHARACTER(LEN=7), PARAMETER :: filename = "fflush1" @@ -39,37 +39,37 @@ ! ! File identifiers ! - INTEGER(HID_T) :: file_id - + INTEGER(HID_T) :: file_id + ! ! Group identifier ! - INTEGER(HID_T) :: gid + INTEGER(HID_T) :: gid ! ! dataset identifier ! INTEGER(HID_T) :: dset_id - + ! ! data type identifier ! INTEGER(HID_T) :: dtype_id ! - !flag to check operation success - ! + !flag to check operation success + ! INTEGER :: error ! - !general purpose integer - ! + !general purpose integer + ! INTEGER :: i, j, total_error = 0 ! - !data buffers - ! + !data buffers + ! INTEGER, DIMENSION(NX,NY) :: data_out INTEGER(HSIZE_T), DIMENSION(2) :: data_dims data_dims(1) = NX @@ -78,7 +78,7 @@ ! !Initialize FORTRAN predifined datatypes ! - CALL h5open_f(error) + CALL h5open_f(error) CALL check("h5open_f",error,total_error) ! @@ -95,13 +95,13 @@ ! !Open the dataset - ! + ! CALL h5dopen_f(file_id, "/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) @@ -128,14 +128,14 @@ ! !Open the group. ! - CALL h5gopen_f(file_id, "G", gid, error) + CALL h5gopen_f(file_id, "G", gid, error) CALL check("h5gopen_f",error,total_error) - + ! !In case error happens, exit. ! IF (error == -1) CALL h5_exit_f (1) - + ! !Close the datatype ! @@ -166,7 +166,7 @@ CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL h5close_f(error) CALL check("h5close_types_f",error,total_error) - + ! if errors detected, exit with non-zero code. IF (total_error .ne. 0) CALL h5_exit_f (1) diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 index f44e373..d8acc29 100644 --- a/fortran/test/fortranlib_test.f90 +++ b/fortran/test/fortranlib_test.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,16 +11,16 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Fortran functionality. ! PROGRAM fortranlibtest - + USE HDF5 - + IMPLICIT NONE INTEGER :: total_error = 0 INTEGER :: error @@ -43,7 +43,7 @@ PROGRAM fortranlibtest WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO") WRITE(*, '(I1)', advance="NO") majnum - WRITE(*, '(".")', advance="NO") + WRITE(*, '(".")', advance="NO") WRITE(*, '(I1)', advance="NO") minnum WRITE(*, '(" release ")', advance="NO") WRITE(*, '(I3)') relnum @@ -60,7 +60,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL mountingtest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Mounting test', total_error) - + ret_total_error = 0 CALL reopentest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Reopen test', total_error) @@ -86,7 +86,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL datasettest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Dataset test', total_error) - + ret_total_error = 0 CALL extenddsettest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Extendible dataset test', total_error) @@ -108,7 +108,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL refobjtest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Reference to object test', total_error) - + ret_total_error = 0 CALL refregtest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Reference to dataset region test', total_error) @@ -126,7 +126,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL test_select_hyperslab( cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Hyperslab selection test', total_error) - + ret_total_error = 0 CALL test_select_element(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Element selection test', total_error) @@ -142,7 +142,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL test_select_bounds(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Selection bounds test ', total_error) - + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing DATATYPE interface ' @@ -165,7 +165,7 @@ PROGRAM fortranlibtest ! write(*,*) ! write(*,*) '=========================================' -! write(*,*) 'Testing PROPERTY interface ' +! write(*,*) 'Testing PROPERTY interface ' ! write(*,*) '=========================================' ret_total_error = 0 @@ -181,7 +181,7 @@ PROGRAM fortranlibtest ! write(*,*) ! write(*,*) '=========================================' -! write(*,*) 'Testing ATTRIBUTE interface ' +! write(*,*) 'Testing ATTRIBUTE interface ' ! write(*,*) '=========================================' ret_total_error = 0 @@ -203,7 +203,7 @@ PROGRAM fortranlibtest ret_total_error = 0 CALL szip_test(szip_flag, cleanup, ret_total_error) - + IF (.NOT. szip_flag) THEN ! test not available CALL write_test_status(-1, ' SZIP filter test', total_error) ELSE @@ -236,7 +236,7 @@ PROGRAM fortranlibtest WRITE(*, fmt = '(i4)', advance='NO') total_error WRITE(*, fmt = '(12a)' ) ' error(s) ! ' WRITE(*,*) ' ============================================ ' - + CALL h5close_f(error) ! if errors detected, exit with non-zero code. diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index 9ab6743..fac83eb 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,10 +11,10 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Fortran wrappers introduced in 1.8 release. ! PROGRAM fortranlibtest @@ -28,7 +28,7 @@ PROGRAM fortranlibtest INTEGER :: majnum, minnum, relnum LOGICAL :: cleanup, status - CALL h5open_f(error) + CALL h5open_f(error) cleanup = .TRUE. CALL h5_env_nocleanup_f(status) @@ -41,7 +41,7 @@ PROGRAM fortranlibtest IF(total_error .EQ. 0) THEN WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO") WRITE(*, '(I1)', advance="NO") majnum - WRITE(*, '(".")', advance="NO") + WRITE(*, '(".")', advance="NO") WRITE(*, '(I1)', advance="NO") minnum WRITE(*, '(" release ")', advance="NO") WRITE(*, '(I3)') relnum @@ -92,7 +92,7 @@ PROGRAM fortranlibtest ' Testing dataspace encoding and decoding', & total_error) - + ! CALL test_hard_query(group_total_error) @@ -112,15 +112,15 @@ PROGRAM fortranlibtest END PROGRAM fortranlibtest SUBROUTINE dtransform(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T) :: dxpl_id_c_to_f INTEGER(HID_T) :: file_id - + CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123" INTEGER :: error CHARACTER(LEN=15) :: ptrgetTest @@ -135,7 +135,7 @@ SUBROUTINE dtransform(cleanup, total_error) CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error) CALL check("dtransform.H5Pcreate_f", error, total_error) - + CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error) CALL check("dtransform.H5Pset_data_transform_f", error, total_error) @@ -177,8 +177,8 @@ END SUBROUTINE dtransform SUBROUTINE test_genprop_basic_class(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error @@ -210,8 +210,8 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error) IF(error.NE.0)THEN WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME total_error = total_error + 1 - ENDIF - + ENDIF + ! /* Check class name smaller buffer*/ CALL H5Pget_class_name_f(cid1, name_small, size, error) CALL check("H5Pget_class_name", error, total_error) @@ -266,8 +266,8 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) !** !****************************************************************/ - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error @@ -296,7 +296,7 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) ! H5S_sel_type sel_type; ! hssize_t nblocks; ! - !Dataset dimensions + !Dataset dimensions ! INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13 @@ -311,15 +311,15 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) ! * Test encoding and decoding of simple dataspace and hyperslab selection. ! *------------------------------------------------------------------------- ! */ - + CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) CALL check("H5Screate_simple", error, total_error) - + CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, & - start, count, error, stride=stride, BLOCK=BLOCK) + start, count, error, stride=stride, BLOCK=BLOCK) CALL check("h5sselect_hyperslab_f", error, total_error) - - + + !/* Encode simple data space in a buffer */ ! First find the buffer size @@ -369,9 +369,9 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) ! CALL h5sclose_f(sid1, error) CALL check("h5sclose_f", error, total_error) - + CALL h5sclose_f(decoded_sid1, error) - CALL check("h5sclose_f", error, total_error) + CALL check("h5sclose_f", error, total_error) ! /*------------------------------------------------------------------------- ! * Test encoding and decoding of scalar dataspace. @@ -417,7 +417,7 @@ SUBROUTINE test_h5s_encode(cleanup, total_error) CALL h5sclose_f(sid3, error) CALL check("h5sclose_f", error, total_error) - + CALL h5sclose_f(decoded_sid3, error) CALL check("h5sclose_f", error, total_error) diff --git a/fortran/test/t.c b/fortran/test/t.c index f2203d0..bf30331 100644 --- a/fortran/test/t.c +++ b/fortran/test/t.c @@ -52,9 +52,9 @@ nh5_fixname_c(_fcd base_name, size_t_f *base_namelen, hid_t_f* fapl, _fcd full_n HD5packFstring(c_full_name, _fcdtocp(full_name), (size_t)*full_namelen); done: - if(c_base_name) + if(c_base_name) HDfree(c_base_name); - if(c_full_name) + if(c_full_name) HDfree(c_full_name); return ret_value; diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index b73dd8a..dd6cbb1 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,23 +11,23 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE attribute_test(cleanup, total_error) -! This subroutine tests following functionalities: +! This subroutine tests following functionalities: ! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f, ! h5aget_name_f,h5aget_space_f, h5aget_type_f, -! +! + + USE HDF5 ! This module contains all necessary modules - USE HDF5 ! This module contains all necessary modules - IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name @@ -35,7 +35,7 @@ CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name CHARACTER(LEN=9), PARAMETER :: aname6 = "attr_null" !Null Attribute name - + ! !data space rank and dimensions ! @@ -45,44 +45,44 @@ - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier for dataset + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier for dataset - INTEGER(HID_T) :: attr_id !String Attribute identifier - INTEGER(HID_T) :: attr2_id !Character Attribute identifier - INTEGER(HID_T) :: attr3_id !Double Attribute identifier - INTEGER(HID_T) :: attr4_id !Real Attribute identifier - INTEGER(HID_T) :: attr5_id !Integer Attribute identifier - INTEGER(HID_T) :: attr6_id !Null Attribute identifier - INTEGER(HID_T) :: aspace_id !String Attribute Dataspace identifier + INTEGER(HID_T) :: attr_id !String Attribute identifier + INTEGER(HID_T) :: attr2_id !Character Attribute identifier + INTEGER(HID_T) :: attr3_id !Double Attribute identifier + INTEGER(HID_T) :: attr4_id !Real Attribute identifier + INTEGER(HID_T) :: attr5_id !Integer Attribute identifier + INTEGER(HID_T) :: attr6_id !Null Attribute identifier + INTEGER(HID_T) :: aspace_id !String Attribute Dataspace identifier INTEGER(HID_T) :: aspace2_id !Character Attribute Dataspace identifier - INTEGER(HID_T) :: aspace6_id !Null Attribute Dataspace identifier - INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier - INTEGER(HID_T) :: atype2_id !Character Attribute Datatype identifier - INTEGER(HID_T) :: atype3_id !Double Attribute Datatype identifier - INTEGER(HID_T) :: atype4_id !Real Attribute Datatype identifier - INTEGER(HID_T) :: atype5_id !Integer Attribute Datatype identifier + INTEGER(HID_T) :: aspace6_id !Null Attribute Dataspace identifier + INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier + INTEGER(HID_T) :: atype2_id !Character Attribute Datatype identifier + INTEGER(HID_T) :: atype3_id !Double Attribute Datatype identifier + INTEGER(HID_T) :: atype4_id !Real Attribute Datatype identifier + INTEGER(HID_T) :: atype5_id !Integer Attribute Datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/2/) ! Attribute dimension INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension INTEGER :: arank = 1 ! Attribure rank INTEGER(SIZE_T) :: attrlen ! Length of the attribute string - INTEGER(HID_T) :: attr_space !Returned String Attribute Space identifier - INTEGER(HID_T) :: attr2_space !Returned other Attribute Space identifier + INTEGER(HID_T) :: attr_space !Returned String Attribute Space identifier + INTEGER(HID_T) :: attr2_space !Returned other Attribute Space identifier INTEGER(HID_T) :: attr_type !Returned Attribute Datatype identifier INTEGER(HID_T) :: attr2_type !Returned CHARACTER Attribute Datatype identifier INTEGER(HID_T) :: attr3_type !Returned DOUBLE Attribute Datatype identifier INTEGER(HID_T) :: attr4_type !Returned REAL Attribute Datatype identifier INTEGER(HID_T) :: attr5_type !Returned INTEGER Attribute Datatype identifier INTEGER(HID_T) :: attr6_type !Returned NULL Attribute Datatype identifier - INTEGER :: num_attrs !number of attributes + INTEGER :: num_attrs !number of attributes INTEGER(HSIZE_T) :: attr_storage ! attributes storage requirements .MSB. CHARACTER(LEN=256) :: attr_name !buffer to put attr_name INTEGER(SIZE_T) :: name_size = 80 !attribute name length CHARACTER(LEN=35), DIMENSION(2) :: attr_data ! String attribute data - CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back + CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back ! string attr data CHARACTER :: attr_character_data = 'A' DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459 @@ -90,7 +90,7 @@ INTEGER, DIMENSION(1) :: attr_integer_data = 5 INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - + CHARACTER :: aread_character_data ! variable to put read back Character attr data INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data @@ -98,19 +98,19 @@ REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data ! - !general purpose integer - ! + !general purpose integer + ! INTEGER :: i, j INTEGER :: error ! Error flag - - ! + + ! !The dimensions for the dataset. ! INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) ! - !data buffers - ! + !data buffers + ! INTEGER, DIMENSION(NX,NY) :: data_in @@ -126,9 +126,9 @@ ! Initialize attribute's data ! attr_data(1) = 'Dataset character attribute' - attr_data(2) = 'Some other string here ' - attrlen = LEN(attr_data(1)) - + attr_data(2) = 'Some other string here ' + attrlen = LEN(attr_data(1)) + ! ! Create the file. ! @@ -141,13 +141,13 @@ CALL check("h5fcreate_f",error,total_error) ! - !Create data space for the dataset. + !Create data space for the dataset. ! CALL h5screate_simple_f(RANK, dims, dataspace, error) CALL check("h5screate_simple_f",error,total_error) ! - ! create dataset in the file. + ! create dataset in the file. ! CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & dset_id, error) @@ -162,17 +162,17 @@ CALL check("h5dwrite_f",error,total_error) ! - ! Create scalar data space for the String attribute. + ! Create scalar data space for the String attribute. ! CALL h5screate_simple_f(arank, adims, aspace_id, error) CALL check("h5screate_simple_f",error,total_error) ! - ! Create scalar data space for all other attributes. + ! Create scalar data space for all other attributes. ! CALL h5screate_simple_f(arank, adims2, aspace2_id, error) CALL check("h5screate_simple_f",error,total_error) ! - ! Create null data space for null attributes. + ! Create null data space for null attributes. ! CALL h5screate_f(H5S_NULL_F, aspace6_id, error) CALL check("h5screate_f",error,total_error) @@ -222,7 +222,7 @@ CALL h5acreate_f(dset_id, aname2, atype2_id, aspace2_id, & attr2_id, error) CALL check("h5acreate_f",error,total_error) - + ! ! Create dataset DOUBLE attribute. @@ -250,7 +250,7 @@ attr6_id, error) CALL check("h5acreate_f",error,total_error) - + ! ! Write the String attribute data. ! @@ -265,20 +265,20 @@ ! ! Write the DOUBLE attribute data. ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr3_id, atype3_id, attr_double_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the Real attribute data. ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr4_id, atype4_id, attr_real_data, data_dims, error) CALL check("h5awrite_f",error,total_error) ! ! Write the Integer attribute data. ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr5_id, atype5_id, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -310,9 +310,9 @@ CALL check("h5aget_storage_size_f",error,total_error) ! CALL verify("h5aget_storage_size_f",attr_storage,0,total_error) - + ! - ! Close the attribute. + ! Close the attribute. ! CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) @@ -394,7 +394,7 @@ ! CALL h5aopen_name_f(dset_id, aname5, attr5_id, error) CALL check("h5aopen_idx_f",error,total_error) - + ! !open the NULL attrbute by name ! @@ -412,7 +412,7 @@ IF (error .NE. 12) THEN total_error = total_error + 1 END IF - + ! !get the STRING attrbute space ! @@ -449,7 +449,7 @@ ! CALL h5aget_type_f(attr5_id, attr5_type, error) CALL check("h5aget_type_f",error,total_error) - + ! !get the null attrbute datatype ! @@ -483,9 +483,9 @@ IF ( (aread_data(1) .NE. attr_data(1)) .OR. (aread_data(2) .NE. attr_data(2)) ) THEN WRITE(*,*) "Read back string attrbute is wrong", aread_data(1), aread_data(2) - total_error = total_error + 1 + total_error = total_error + 1 END IF - + ! !read the CHARACTER attribute data back to memory ! @@ -493,51 +493,51 @@ CALL check("h5aread_f",error,total_error) IF (aread_character_data .NE. 'A' ) THEN WRITE(*,*) "Read back character attrbute is wrong ",aread_character_data - total_error = total_error + 1 + total_error = total_error + 1 END IF ! !read the double attribute data back to memory ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error) CALL check("h5aread_f",error,total_error) IF (aread_double_data(1) .NE. 3.459 ) THEN WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1) total_error = total_error + 1 - END IF + END IF ! !read the real attribute data back to memory ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error) CALL check("h5aread_f",error,total_error) IF (aread_real_data(1) .NE. 4.0 ) THEN WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data - total_error = total_error + 1 - END IF + total_error = total_error + 1 + END IF ! !read the Integer attribute data back to memory ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5aread_f(attr5_id, H5T_NATIVE_INTEGER, aread_integer_data, data_dims, error) CALL check("h5aread_f",error,total_error) IF (aread_integer_data(1) .NE. 5 ) THEN WRITE(*,*) "Read back integer attrbute is wrong ", aread_integer_data - total_error = total_error + 1 - END IF + total_error = total_error + 1 + END IF ! !read the null attribute data. nothing can be read. ! - data_dims(1) = 1 + data_dims(1) = 1 CALL h5aread_f(attr6_id, H5T_NATIVE_INTEGER, aread_null_data, data_dims, error) CALL check("h5aread_f",error,total_error) IF (aread_null_data(1) .NE. 7 ) THEN WRITE(*,*) "Read back null attrbute is wrong ", aread_null_data - total_error = total_error + 1 - END IF - + total_error = total_error + 1 + END IF + ! - ! Close the attribute. + ! Close the attribute. ! CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) @@ -553,9 +553,9 @@ CALL check("h5aclose_f",error,total_error) ! - ! Delete the attribute from the Dataset. + ! Delete the attribute from the Dataset. ! - CALL h5adelete_f(dset_id, aname, error) + CALL h5adelete_f(dset_id, aname, error) CALL check("h5adelete_f",error,total_error) ! @@ -591,13 +591,13 @@ CALL h5tclose_f(attr6_type, error) CALL check("h5tclose_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) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90 index 58408ee..223877c 100644 --- a/fortran/test/tH5A_1_8.f90 +++ b/fortran/test/tH5A_1_8.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,22 +11,22 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! -SUBROUTINE attribute_test_1_8(cleanup, total_error) +SUBROUTINE attribute_test_1_8(cleanup, total_error) ! This subroutine tests following 1.8 functionalities: ! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f, ! h5aget_name_f,h5aget_space_f, h5aget_type_f, H5Pset_shared_mesg_nindexes_f, ! H5Pset_shared_mesg_index_f -! +! - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - + INTEGER, INTENT(INOUT) :: total_error + CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name @@ -35,7 +35,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name CHARACTER(LEN=9), PARAMETER :: aname6 = "attr_null" !Null Attribute name - + ! !data space rank and dimensions ! @@ -44,11 +44,11 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) INTEGER, PARAMETER :: NY = 5 ! - !general purpose integer - ! + !general purpose integer + ! INTEGER :: i, j INTEGER :: error ! Error flag - + ! NEW STARTS HERE INTEGER(HID_T) :: fapl = -1, fapl2 = -1 INTEGER(HID_T) :: fcpl = -1, fcpl2 = -1 @@ -63,7 +63,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) ! ******************** ! WRITE(*,*) "TESTING ATTRIBUTES" - + CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl,error) CALL check("h5Pcreate_f",error,total_error) CALL h5pcopy_f(fapl, fapl2, error) @@ -71,7 +71,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) CALL H5Pcreate_f(H5P_FILE_CREATE_F,fcpl,error) CALL check("h5Pcreate_f",error,total_error) - + CALL h5pcopy_f(fcpl, fcpl2, error) CALL check("h5pcopy_f",error,total_error) @@ -118,13 +118,13 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) my_fcpl = fcpl END IF !!$ CALL test_attr_dense_create(my_fcpl, my_fapl) - + ret_total_error = 0 CALL test_attr_dense_open(my_fcpl, my_fapl, ret_total_error) CALL write_test_status(ret_total_error, & ' - Testing INT attributes on both datasets and groups', & total_error) - + !!$ CALL test_attr_dense_delete(my_fcpl, my_fapl) !!$ CALL test_attr_dense_rename(my_fcpl, my_fapl) !!$ CALL test_attr_dense_unlink(my_fcpl, my_fapl) @@ -147,7 +147,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) CALL write_test_status(ret_total_error, & ' - Testing creating objects with attribute creation order', & total_error) - + ret_total_error = 0 CALL test_attr_corder_create_compact(my_fcpl, my_fapl, ret_total_error) CALL write_test_status(ret_total_error, & @@ -162,13 +162,13 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) CALL write_test_status(ret_total_error, & ' - Testing querying attribute info by index', & total_error) - + ret_total_error = 0 CALL test_attr_delete_by_idx(new_format, my_fcpl, my_fapl, ret_total_error) CALL write_test_status(ret_total_error, & ' - Testing deleting attribute by index', & total_error) - + !!$ CALL test_attr_iterate2(new_format, my_fcpl, my_fapl) !!$ CALL test_attr_open_by_idx(new_format, my_fcpl, my_fapl) !!$ CALL test_attr_open_by_name(new_format, my_fcpl, my_fapl) @@ -192,7 +192,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error) CALL write_test_status(ret_total_error,& ' - Testing deleting shared attributes in "compact" & "dense" storage', & total_error) - + !!$ CALL test_attr_shared_unlink(my_fcpl, my_fapl) END IF @@ -264,16 +264,16 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) INTEGER(HID_T) :: my_dataset INTEGER :: u - + INTEGER :: max_compact ! Maximum # of links to store in group compactly INTEGER :: min_dense ! Minimum # of links to store in group "densely" CHARACTER(LEN=7) :: attrname CHARACTER(LEN=2) :: chr2 - INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr !String Attribute identifier INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters @@ -330,7 +330,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error) CALL check("h5acreate_f",error,total_error) - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -354,7 +354,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - + ! /* Close file */ CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) @@ -404,7 +404,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) f_corder_valid, corder, cset, data_size, error, lapl_id = H5P_DEFAULT_F ) !with optional CALL check("H5Aget_info_by_name_f", error, total_error) - + ! /* Verify creation order of attribute */ CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) @@ -417,7 +417,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) f_corder_valid, corder, cset, data_size, error) ! without optional CALL check("H5Aget_info_by_name_f", error, total_error) - + ! /* Verify creation order of attribute */ CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) @@ -432,7 +432,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - + ! /* Close file */ CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) @@ -463,24 +463,24 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) INTEGER :: error - + INTEGER :: value_scalar INTEGER, DIMENSION(1) :: value - INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr !String Attribute identifier INTEGER(HID_T) :: attr_sid INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - INTEGER(HSIZE_T) :: storage_size ! attributes storage requirements + INTEGER(HSIZE_T) :: storage_size ! attributes storage requirements - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters - + LOGICAL :: equal ! test: H5Sextent_equal_f - + data_dims = 0 ! /* Output message about test being performed */ @@ -532,7 +532,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) CALL H5Sextent_equal_f(attr_sid, null_sid, equal, error) CALL check("H5Sextent_equal_f",error,total_error) CALL Verifylogical("H5Sextent_equal_f",equal,.TRUE.,total_error) - + !!$ ret = H5Sclose(attr_sid) !!$ CALL CHECK(ret, FAIL, "H5Sclose") @@ -586,7 +586,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) IMPLICIT NONE INTEGER(SIZE_T), PARAMETER :: NAME_BUF_SIZE = 7 - LOGICAL :: new_format + LOGICAL :: new_format INTEGER(HID_T), INTENT(IN) :: fcpl INTEGER(HID_T), INTENT(IN) :: fapl INTEGER, INTENT(INOUT) :: total_error @@ -616,7 +616,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) CHARACTER(LEN=2) :: chr2 - LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) INTEGER :: Input1 INTEGER :: i @@ -666,10 +666,10 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl ) CALL check("h5dcreate_f2",error,total_error) - + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error, dcpl_id=dcpl ) CALL check("h5dcreate_f3",error,total_error) - + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl_id=dcpl ) CALL check("h5dcreate_f4",error,total_error) @@ -704,12 +704,12 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 CALL H5Acreate_by_name_f(fid, dsetname, attrname, H5T_NATIVE_INTEGER, sid, & - attr, error, lapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) + attr, error, lapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) CALL check("H5Acreate_by_name_f",error,total_error) - + ! /* Write data into the attribute */ - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -751,7 +751,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) my_dataset = dset3 dsetname = DSET3_NAME END SELECT - + ! /* Create more attributes, to push into dense form */ DO u = max_compact, max_compact* 2 - 1 @@ -763,7 +763,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) CALL check("H5Acreate_by_name",error,total_error) ! /* Write data into the attribute */ - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -867,7 +867,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) INTEGER(HID_T) :: attr !String Attribute identifier INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters @@ -895,7 +895,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) data_dims = 0 ! /* Create dataspace for dataset & attributes */ - + CALL h5screate_f(H5S_SCALAR_F, sid, error) CALL check("h5screate_f",error,total_error) @@ -911,7 +911,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL check("H5Pget_attr_phase_change_f",error,total_error) ! /* Loop over using index for creation order value */ - + DO i = 1, 2 ! /* Output message about test being performed */ @@ -937,18 +937,18 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) ENDIF ! /* Create datasets */ - + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error ) CALL check("h5dcreate_f",error,total_error) - + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error ) CALL check("h5dcreate_f",error,total_error) - + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error ) CALL check("h5dcreate_f",error,total_error) ! /* Work on all the datasets */ - + DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) @@ -974,7 +974,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) ! -- CHECK PASSING AN INTEGER CONSTANT IN DIFFERENT FORMS -- - ! 1) call by passing an integer with the _hsize_t declaration + ! 1) call by passing an integer with the _hsize_t declaration CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, 0_hsize_t, & f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F) @@ -986,13 +986,13 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error) - + ! 3) call by passing a variable with the attribute hsize_t CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, & f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("h5aget_info_by_idx_f",error,minusone,total_error) - + CALL h5aget_name_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, & hzero, tmpname, error, size, lapl_id=H5P_DEFAULT_F) CALL VERIFY("h5aget_name_by_idx_f",error,minusone,total_error) @@ -1009,7 +1009,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) ! check with the optional information create2 specs. CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - + ! /* Write data into the attribute */ attr_integer_data(1) = j @@ -1023,7 +1023,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) CALL check("h5aclose_f",error,total_error) ! /* Verify information for new attribute */ - + !EP CALL attr_info_by_idx_check(my_dataset, attrname, INT(j,HSIZE_T), use_index(i), total_error ) htmp = j CALL attr_info_by_idx_check(my_dataset, attrname, htmp, use_index(i), total_error ) @@ -1045,7 +1045,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) ! /* Close file */ CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) - + END DO ! /* Close property list */ @@ -1071,7 +1071,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) CHARACTER(LEN=*) :: attrname INTEGER(HSIZE_T) :: n LOGICAL :: use_index - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters @@ -1084,7 +1084,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) ! /* Verify the information for first attribute, in increasing creation order */ CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, & f_corder_valid, corder, cset, data_size, error) - + CALL check("h5aget_info_by_idx_f",error,total_error) CALL verify("h5aget_info_by_idx_f",corder,0,total_error) ! /* Verify the information for new attribute, in increasing creation order */ @@ -1143,25 +1143,25 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) - + !EP CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, & ! -- CHECK PASSING AN INTEGER CONSTANT IN DIFFERENT FORMS -- - ! 1) call by passing an integer with the _hsize_t declaration + ! 1) call by passing an integer with the _hsize_t declaration CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, & f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) - + ! 2) call by passing an integer with the INT(,hsize_t) declaration CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, INT(0,HSIZE_T), & f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_by_idx_f",error,total_error) - CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) - + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) + ! 3) call by passing a variable with the attribute hsize_t CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, hzero, & @@ -1244,7 +1244,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) CHARACTER(LEN=11) :: attrname2 CHARACTER(LEN=1), PARAMETER :: chr1 = '.' - + INTEGER :: u INTEGER, PARAMETER :: SPACE1_RANK = 3 INTEGER, PARAMETER :: NX = 20 @@ -1301,7 +1301,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error) ! /* Make attributes > 500 bytes shared */ - CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) + CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */ CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error) CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error) @@ -1321,7 +1321,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! /* Re-open file */ CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) CALL check("h5open_f",error,total_error) - + ! /* Commit datatype to file */ IF(test_shared.EQ.2) THEN CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F) @@ -1366,16 +1366,16 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) !!$ is_dense = H5O_is_attr_dense_test(dataset2); !!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); ! /* Add attributes to each dataset, until after converting to dense storage */ - + DO u = 0, (max_compact * 2) - 1 ! /* Create attribute name */ WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - + ! /* Alternate between creating "small" & "big" attributes */ - + IF(MOD(u+1,2).EQ.0)THEN ! /* Create "small" attribute on first dataset */ @@ -1412,13 +1412,13 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) attr_integer_data(1) = u + 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) - + ! Check refcount for attribute */ !!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); !!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); !!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); ENDIF - + ! /* Close attribute */ CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) @@ -1444,7 +1444,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) !!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); !!$ ! /* Write data into the attribute */ - + attr_integer_data(1) = u + 1 data_dims(1) = 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) @@ -1452,7 +1452,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ELSE ! /* Create "big" attribute on second dataset */ - + CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) @@ -1467,7 +1467,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) !!$ ! /* Write data into the attribute */ - + attr_integer_data(1) = u + 1 data_dims(1) = 1 ! CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) @@ -1493,7 +1493,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! /* Create new attribute name */ - + WRITE(chr2,'(I2.2)') u attrname2 = 'new attr '//chr2 @@ -1556,7 +1556,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! /* Change second dataset's attribute's name back to original */ - + CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname2, attrname, error) CALL check("H5Arename_by_name_f",error,total_error) @@ -1611,7 +1611,7 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) ! /* Close attribute */ CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) - + ENDDO ! /* Close attribute's datatype */ @@ -1696,7 +1696,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) !****************************************************************/ USE HDF5 - + IMPLICIT NONE LOGICAL, INTENT(IN) :: new_format @@ -1723,7 +1723,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) INTEGER(HID_T) :: attr !String Attribute identifier INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters @@ -1742,14 +1742,14 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) INTEGER(SIZE_T) :: size CHARACTER(LEN=8) :: tmpname CHARACTER(LEN=1), PARAMETER :: chr1 = '.' - + INTEGER :: idx_type INTEGER :: order INTEGER :: u ! /* Local index variable */ INTEGER :: Input1 INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T INTEGER :: minusone = -1 - + data_dims = 0 ! /* Create dataspace for dataset & attributes */ @@ -1770,10 +1770,10 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! /* Loop over operating in different orders */ DO order = H5_ITER_INC_F, H5_ITER_DEC_F - + ! /* Loop over using index for creation order value */ DO i = 1, 2 - + ! /* Print appropriate test message */ !!$ IF(idx_type .EQ. H5_INDEX_CRT_ORDER_F)THEN !!$ IF(order .EQ. H5_ITER_INC_F) THEN @@ -1828,18 +1828,18 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ENDIF ! /* Create datasets */ - + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl ) CALL check("h5dcreate_f2",error,total_error) - + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error, dcpl ) CALL check("h5dcreate_f3",error,total_error) - + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl ) CALL check("h5dcreate_f4",error,total_error) - + ! /* Work on all the datasets */ - + DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) CASE (0) @@ -1851,44 +1851,44 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! CASE DEFAULT ! CALL HDassert(0.AND."Toomanydatasets!") END SELECT - + ! /* Check on dataset's attribute storage status */ !!$ is_empty = H5O_is_attr_empty_test(my_dataset); !!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); !!$ is_dense = H5O_is_attr_dense_test(my_dataset); !!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); - + ! /* Check for deleting non-existant attribute */ !EP CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F) CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, hzero,error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) - + ! /* Create attributes, up to limit of compact form */ DO u = 0, max_compact - 1 ! /* Create attribute */ WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) - + ! /* Write data into the attribute */ attr_integer_data(1) = u data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) - + ! /* Close attribute */ CALL h5aclose_f(attr, error) CALL check("h5aclose_f",error,total_error) ! /* Verify information for new attribute */ CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error ) - + ENDDO - + ! /* Verify state of object */ !!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); @@ -1902,7 +1902,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) !/* Check for out of bound deletions */ CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F) CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error) - + ENDDO @@ -1917,18 +1917,18 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! CASE DEFAULT ! CALL HDassert(0.AND."Toomanydatasets!") END SELECT - + ! /* Delete attributes from compact storage */ - + DO u = 0, max_compact - 2 - + ! /* Delete first attribute in appropriate order */ - - + + !EP CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error) CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, hzero, error) CALL check("H5Adelete_by_idx_f",error,total_error) - + ! /* Verify the attribute information for first attribute in appropriate order */ ! HDmemset(&ainfo, 0, sizeof(ainfo)); @@ -1936,7 +1936,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) !EP CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, & CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, hzero, & f_corder_valid, corder, cset, data_size, error) - + IF(new_format)THEN IF(order.EQ.H5_ITER_INC_F)THEN CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error) @@ -1944,7 +1944,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ELSE CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error) ENDIF - + ! /* Verify the name for first attribute in appropriate order */ ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); @@ -1969,14 +1969,14 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, hzero, error) CALL check("H5Adelete_by_idx_f",error,total_error) - + ! /* Verify state of attribute storage (empty) */ !!$ is_empty = H5O_is_attr_empty_test(my_dataset); !!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); ENDDO ! /* Work on all the datasets */ - + DO curr_dset = 0,NUM_DSETS-1 SELECT CASE (curr_dset) CASE (0) @@ -1996,7 +1996,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! /* Create attribute */ WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) @@ -2067,7 +2067,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error) CALL check("H5Adelete_by_idx_f",error,total_error) ! /* Verify the attribute information for first attribute in appropriate order */ - + CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), & f_corder_valid, corder, cset, data_size, error) IF(new_format)THEN @@ -2081,7 +2081,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) ! /* Verify the name for first attribute in appropriate order */ ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); - size = 7 ! *CHECK* if not the correct size + size = 7 ! *CHECK* if not the correct size CALL h5aget_name_by_idx_f(my_dataset, ".", idx_type, order,INT(0,hsize_t), & tmpname, error, size) @@ -2089,12 +2089,12 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) WRITE(chr2,'(I2.2)') u + 1 attrname = 'attr '//chr2 ELSE - WRITE(chr2,'(I2.2)') max_compact * 2 - (u + 2) + WRITE(chr2,'(I2.2)') max_compact * 2 - (u + 2) attrname = 'attr '//chr2 ENDIF IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1 CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) - + ENDDO ! /* Delete last attribute */ @@ -2117,7 +2117,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) CALL check("h5dclose_f",error,total_error) CALL h5dclose_f(dset3, error) CALL check("h5dclose_f",error,total_error) - + ! /* Close file */ CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) @@ -2145,7 +2145,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) !****************************************************************/ USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl @@ -2179,7 +2179,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CHARACTER(LEN=7) :: attrname CHARACTER(LEN=1), PARAMETER :: chr1 = '.' - + INTEGER :: u INTEGER, PARAMETER :: SPACE1_RANK = 3 INTEGER, PARAMETER :: NX = 20 @@ -2209,7 +2209,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ! /* Loop over type of shared components */ DO test_shared = 0, 2 - + ! /* Make copy of file creation property list */ CALL H5Pcopy_f(fcpl, my_fcpl, error) @@ -2271,7 +2271,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) - + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl ) CALL check("h5dcreate_f",error,total_error) @@ -2303,13 +2303,13 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) !!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); !!$ ! /* Add attributes to each dataset, until after converting to dense storage */ - + DO u = 0, (max_compact * 2) - 1 ! /* Create attribute name */ WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - + ! /* Alternate between creating "small" & "big" attributes */ IF(MOD(u+1,2).EQ.0)THEN @@ -2387,7 +2387,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ELSE ! /* Create "big" attribute on second dataset */ - + CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) CALL check("h5acreate_f",error,total_error) @@ -2402,7 +2402,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) !!$ ! /* Write data into the attribute */ - + attr_integer_data(1) = u + 1 data_dims(1) = 1 CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) @@ -2469,7 +2469,7 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) ENDDO ! /* Close attribute's datatype */ - + CALL h5tclose_f(attr_tid, error) CALL check("h5tclose_f",error,total_error) @@ -2556,7 +2556,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) !****************************************************************/ USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl @@ -2618,7 +2618,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) CALL check("H5Pset_attr_creation_order",error,total_error) ! /* Create a dataset */ - + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, & lcpl_id=H5P_DEFAULT_F, dcpl_id=dcpl, dapl_id=H5P_DEFAULT_F) CALL check("h5dcreate_f",error,total_error) @@ -2647,7 +2647,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) ! /* Write data into the attribute */ - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -2666,7 +2666,7 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) ! /* Add one more attribute, to push into "dense" storage */ ! /* Create attribute */ - + WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -2677,9 +2677,9 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) !!$ is_dense = H5O_is_attr_dense_test(dataset); !!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); - + ! /* Write data into the attribute */ - data_dims(1) = 1 + data_dims(1) = 1 CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) CALL check("h5awrite_f",error,total_error) @@ -2724,7 +2724,7 @@ END SUBROUTINE test_attr_dense_open SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: loc_id @@ -2739,7 +2739,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) CHARACTER(LEN=ATTR_NAME_LEN) :: check_name INTEGER(HSIZE_T), DIMENSION(7) :: data_dims - INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr !String Attribute identifier INTEGER :: error INTEGER :: value @@ -2785,7 +2785,7 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) attr, error, aapl_id=H5P_DEFAULT_F) ! /* Verify Name */ - + WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 @@ -2819,7 +2819,7 @@ END SUBROUTINE test_attr_dense_verify SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fcpl @@ -2849,7 +2849,7 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) ! /* Create dataset creation property list */ CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) CALL check("h5Pcreate_f",error,total_error) - + ! /* Get creation order indexing on object */ CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) CALL check("H5Pget_attr_creation_order_f",error,total_error) @@ -2919,11 +2919,11 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) ! /* Close property list */ CALL h5pclose_f(dcpl, error) CALL check("h5pclose_f",error,total_error) - + ! /* Close Dataset */ CALL h5dclose_f(dataset, error) CALL check("h5dclose_f",error,total_error) - + ! /* Close file */ CALL h5fclose_f(fid, error) CALL check("h5fclose_f",error,total_error) @@ -2941,7 +2941,7 @@ END SUBROUTINE test_attr_corder_create_basic SUBROUTINE test_attr_basic_write(fapl, total_error) USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl @@ -2962,11 +2962,11 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CHARACTER(LEN=25) :: check_name CHARACTER(LEN=18) :: chr_exact_size - INTEGER, PARAMETER :: SPACE1_RANK = 2 + INTEGER, PARAMETER :: SPACE1_RANK = 2 CHARACTER(LEN=5), PARAMETER :: ATTR1_NAME="Attr1" - INTEGER, PARAMETER :: ATTR1_RANK = 1 - INTEGER, PARAMETER :: ATTR1_DIM1 = 3 + INTEGER, PARAMETER :: ATTR1_RANK = 1 + INTEGER, PARAMETER :: ATTR1_DIM1 = 3 CHARACTER(LEN=7), PARAMETER :: ATTR1A_NAME ="Attr1_a" CHARACTER(LEN=18), PARAMETER :: ATTR_TMP_NAME = "Attr1_a-1234567890" INTEGER, DIMENSION(ATTR1_DIM1) :: attr_data1 @@ -3021,7 +3021,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL H5Gopen_f(fid1, "/", group, error, H5P_DEFAULT_F) CALL check("H5Gopen_f",error,total_error) - ! /* Open attribute again */ + ! /* Open attribute again */ CALL h5aopen_f(group, ATTR1_NAME, attr, error) CALL check("h5aopen_f",error,total_error) @@ -3038,7 +3038,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error) CALL check("h5acreate_f",error,total_error) ! /* Write attribute information */ - + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, dimsa, error) CALL check("h5awrite_f",error,total_error) @@ -3144,7 +3144,7 @@ END SUBROUTINE test_attr_basic_write SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) USE HDF5 - + IMPLICIT NONE LOGICAL, INTENT(IN) :: new_format @@ -3188,7 +3188,7 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) ! /* Create group for attributes */ - CALL H5Gcreate_f(fid, GROUP1_NAME, gid, error) + CALL H5Gcreate_f(fid, GROUP1_NAME, gid, error) CALL check("H5Gcreate_f", error, total_error) ! /* Create many attributes */ @@ -3266,7 +3266,7 @@ END SUBROUTINE test_attr_many SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fid CHARACTER(LEN=*), INTENT(IN) :: dsetname @@ -3278,7 +3278,7 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CHARACTER (LEN=8) :: attrname INTEGER, PARAMETER :: NUM_DSETS = 3 INTEGER :: error - LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters @@ -3293,14 +3293,14 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) WRITE(chr2,'(I2.2)') u attrname = 'attr '//chr2 - - + + CALL h5aopen_f(obj_id, attrname, attr_id, error) CALL check("h5aopen_f",error,total_error) ! /* Get the attribute's information */ - + CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) CALL check("h5aget_info_f",error,total_error) @@ -3310,7 +3310,7 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error) CALL h5aget_storage_size_f(attr_id, storage_size, error) CALL check("h5aget_storage_size_f",error,total_error) - + CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error) diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90 index e704db2..56e82f4 100644 --- a/fortran/test/tH5D.f90 +++ b/fortran/test/tH5D.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,10 +11,10 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Dataset Interface functionality. ! ! @@ -23,20 +23,20 @@ ! h5dread_f, and h5dwrite_f ! SUBROUTINE datasettest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name CHARACTER(LEN=9), PARAMETER :: null_dsetname = "null_dset" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: null_dset ! Null dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: null_dset ! Null dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: null_dspace ! Null dataspace identifier INTEGER(HID_T) :: dtype_id ! Datatype identifier @@ -65,7 +65,7 @@ ! ! 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" @@ -75,12 +75,12 @@ CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) CALL check("h5screate_simple_f", error, total_error) - ! + ! ! Create null dataspace. ! CALL h5screate_f(H5S_NULL_F, null_dspace, error) @@ -94,7 +94,7 @@ dset_id, error) CALL check("h5dcreate_f", error, total_error) ! - ! Create the null dataset. + ! Create the null dataset. ! CALL h5dcreate_f(file_id, null_dsetname, H5T_NATIVE_INTEGER, null_dspace, & null_dset, error) @@ -104,20 +104,20 @@ ! Write the dataset. ! data_dims(1) = 4 - data_dims(2) = 6 + data_dims(2) = 6 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) CALL check("h5dwrite_f", error, total_error) ! ! Write null dataset. Nothing can be written. - ! - null_data_dim(1) = 1 + ! + null_data_dim(1) = 1 CALL h5dwrite_f(null_dset, H5T_NATIVE_INTEGER, null_dset_data, null_data_dim, 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) CALL h5dclose_f(null_dset, error) @@ -131,7 +131,7 @@ CALL h5sclose_f(null_dspace, error) CALL check("h5sclose_f", error, total_error) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -144,7 +144,7 @@ CALL check("h5fopen_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) @@ -152,13 +152,13 @@ CALL check("h5dopen_f", error, total_error) ! - ! Get the dataset type. + ! 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. + ! Get the data space. ! CALL h5dget_space_f(dset_id, dspace_id, error) CALL check("h5dget_space_f", error, total_error) @@ -176,26 +176,26 @@ ! !Compare the data. - ! + ! do i = 1, 4 do j = 1, 6 - IF (data_out(i,j) .NE. dset_data(i, j)) THEN + 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 do ! ! Check if no change to null_dset_data ! - IF (null_dset_data .NE. 1) THEN + IF (null_dset_data .NE. 1) THEN write(*, *) "null dataset test error occured" END IF - ! + ! ! End access to the dataset and release resources used by it. - ! + ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(null_dset, error) @@ -212,14 +212,14 @@ ! 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) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE datasettest @@ -228,11 +228,11 @@ ! SUBROUTINE extenddsettest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error ! !the dataset is stored in file "extf.h5" @@ -250,11 +250,11 @@ ! INTEGER :: RANK = 2 - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier - INTEGER(HID_T) :: memspace ! memory Dataspace identifier - INTEGER(HID_T) :: crp_list ! dataset creatation property identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memory Dataspace identifier + INTEGER(HID_T) :: crp_list ! dataset creatation property identifier ! !dataset dimensions at creation time @@ -262,44 +262,44 @@ INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/) ! - !data dimensions + !data dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/) ! !Maximum dimensions ! - INTEGER(HSIZE_T), DIMENSION(2) :: maxdims + INTEGER(HSIZE_T), DIMENSION(2) :: maxdims ! - !data arrays for reading and writing + !data arrays for reading and writing ! INTEGER, DIMENSION(10,3) :: data_in, data_out ! - !Size of data in the file + !Size of data in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: size ! - !general purpose integer + !general purpose integer ! INTEGER :: i, j ! - !flag to check operation success + !flag to check operation success ! - INTEGER :: error + INTEGER :: error ! !Variables used in reading data back - ! + ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr INTEGER :: rankr INTEGER(HSIZE_T), DIMENSION(2) :: data_dims ! - !data initialization + !data initialization ! do i = 1, 10 do j = 1, 3 @@ -310,12 +310,12 @@ ! !Initialize FORTRAN predifined datatypes ! -! CALL h5init_types_f(error) +! CALL h5init_types_f(error) ! CALL check("h5init_types_f",error,total_error) ! !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" @@ -361,8 +361,8 @@ ! !Extend the dataset. Dataset becomes 10 x 3. ! - size(1) = 10; - size(2) = 3; + size(1) = 10; + size(2) = 3; CALL h5dextend_f(dset_id, size, error) CALL check("h5dextend_f",error,total_error) @@ -451,7 +451,7 @@ CALL check("h5screate_simple_f",error,total_error) ! - !Read data + !Read data ! CALL H5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & memspace, dataspace) @@ -460,14 +460,14 @@ ! !Compare the data. - ! + ! do i = 1, dims1(1) do j = 1, dims1(2) - IF (data_out(i,j) .NE. data_in(i, j)) THEN + IF (data_out(i,j) .NE. data_in(i, j)) THEN write(*, *) "extend dataset test error occured" write(*, *) "read value is not the same as the written values" END IF - end do + end do end do ! @@ -503,6 +503,6 @@ CALL check("h5_cleanup_f", error, total_error) RETURN - END SUBROUTINE extenddsettest + END SUBROUTINE extenddsettest diff --git a/fortran/test/tH5E.f90 b/fortran/test/tH5E.f90 index 7bd2402..a4912bd 100644 --- a/fortran/test/tH5E.f90 +++ b/fortran/test/tH5E.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,35 +11,35 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE error_report_test(cleanup, total_error) ! This subroutine tests following functionalities: h5eprint_f - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=6), PARAMETER :: filename = "etestf" ! File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=8), PARAMETER :: err_filename = "err_file"! Error output file CHARACTER(LEN=80) :: fix_err_filename - - + + INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: grp_id ! Group identifier INTEGER :: error, tmp_error, err_flag - - err_flag = 0 + + err_flag = 0 CALL h5eset_auto_f(err_flag, error) CALL check("h5eprint_f",error, total_error) ! ! 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" @@ -47,7 +47,7 @@ endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - + ! ! Try to open non-existing group in the file. ! Error message should go to the err_file_name file. @@ -61,8 +61,8 @@ CALL h5eprint_f(error, fix_err_filename) CALL h5gopen_f(file_id, "Doesnotexist2", grp_id, tmp_error) CALL h5eprint_f(error, fix_err_filename) - - ! + + ! ! Close the file. ! CALL h5fclose_f(file_id, error) diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 index af2d7d6..4b88cb3 100644 --- a/fortran/test/tH5F.f90 +++ b/fortran/test/tH5F.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,27 +11,27 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing File Interface functionality. ! -! In the mountingtest subroutine we create one file with a group in it, +! In the mountingtest subroutine we create one file with a group in it, ! and another file with a dataset. Mounting is used to -! access the dataset from the second file as a member of a group -! in the first file. +! access the dataset from the second file as a member of a group +! in the first file. ! SUBROUTINE mountingtest(cleanup, total_error) USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error ! !the respective filename is "mount1.h5" and "mount2.h5" ! - CHARACTER(LEN=6) :: filename1 + CHARACTER(LEN=6) :: filename1 CHARACTER(LEN=6) :: filename2 CHARACTER(LEN=80) :: fix_filename1 CHARACTER(LEN=80) :: fix_filename2 @@ -46,12 +46,12 @@ ! ! File identifiers ! - INTEGER(HID_T) :: file1_id, file2_id + INTEGER(HID_T) :: file1_id, file2_id ! ! Group identifier ! - INTEGER(HID_T) :: gid + INTEGER(HID_T) :: gid ! ! dataset identifier @@ -68,29 +68,29 @@ ! 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 - ! + !flag to check operation success + ! INTEGER :: error ! - !general purpose integer - ! + !general purpose integer + ! INTEGER :: i, j ! - !data buffers - ! + !data buffers + ! INTEGER, DIMENSION(NX,NY) :: data_in, data_out INTEGER(HSIZE_T), DIMENSION(2) :: data_dims @@ -114,26 +114,26 @@ ! Fix names of the files ! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if(error .ne. 0) stop + if(error .ne. 0) stop CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if(error .ne. 0) stop + if(error .ne. 0) stop ! !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) - + ! !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) @@ -141,19 +141,19 @@ ! !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. + !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) @@ -168,7 +168,7 @@ ! !close file, dataset and dataspace identifiers. - ! + ! CALL h5sclose_f(dataspace, error) CALL check("h5sclose_f",error,total_error) CALL h5dclose_f(dset_id, error) @@ -195,7 +195,7 @@ ! !reopen both files. - ! + ! CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) CALL check("hfopen_f",error,total_error) CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) @@ -203,44 +203,44 @@ ! !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 + IF (data_out(i,j) .NE. data_in(i, j)) THEN write(*, *) "mounting test error occured" END IF - end do + 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) @@ -248,13 +248,13 @@ ! !unmount the second file. - ! + ! CALL h5funmount_f(file1_id, "/G", error); CALL check("h5funmount_f",error,total_error) ! !Close both files. - ! + ! CALL h5fclose_f(file1_id, error) CALL check("h5fclose_f",error,total_error) CALL h5fclose_f(file2_id, error) @@ -269,27 +269,27 @@ ! ! The following subroutine tests h5freopen_f. -! It creates the file which has name "reopen.h5" and +! 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 +! 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 +! read is identical to the data written ! SUBROUTINE reopentest(cleanup, total_error) USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - + INTEGER, INTENT(OUT) :: total_error + ! CHARACTER(LEN=6), PARAMETER :: filename = "reopen" - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename - INTEGER(HID_T) :: file_id, reopen_id ! File identifiers - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: file_id, reopen_id ! File identifiers + INTEGER(HID_T) :: dset_id ! Dataset identifier ! !dataset name is "dset" @@ -308,30 +308,30 @@ ! 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 + !array to store data ! INTEGER, DIMENSION(4,6) :: dset_data, data_out INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HSIZE_T) :: file_size CHARACTER(LEN=80) :: file_name INTEGER(SIZE_T) :: name_size - + ! !initialize the dset_data array which will be written to the "/dset" ! @@ -344,13 +344,13 @@ ! !Initialize FORTRAN predifined datatypes ! -! CALL h5init_types_f(error) +! CALL h5init_types_f(error) ! CALL check("h5init_types_f",error,total_error) ! !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" @@ -360,14 +360,14 @@ CALL check("h5fcreate_f",error,total_error) ! - !Create data space for the dataset. + !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) @@ -393,7 +393,7 @@ CALL check("h5sclose_f",error,total_error) ! - !Reopen file dsetf.h5. + !Reopen file dsetf.h5. ! CALL h5freopen_f(file_id, reopen_id, error) CALL check("h5freopen_f",error,total_error) @@ -404,7 +404,7 @@ CALL check("h5fget_filesize_f",error,total_error) ! - !Open the dataset based on the reopen_id. + !Open the dataset based on the reopen_id. ! CALL h5dopen_f(reopen_id, dsetname, dset_id, error) CALL check("h5dopen_f",error,total_error) @@ -415,7 +415,7 @@ 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 + END IF ! !Read the dataset. @@ -425,13 +425,13 @@ ! !Compare the data. - ! + ! do i = 1, NX do j = 1, NY - IF (data_out(i,j) .NE. dset_data(i, j)) THEN + IF (data_out(i,j) .NE. dset_data(i, j)) THEN write(*, *) "reopen test error occured" END IF - end do + end do end do @@ -448,7 +448,7 @@ 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) @@ -462,13 +462,13 @@ ! 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 +! created using the got property lists SUBROUTINE plisttest(cleanup, total_error) USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error ! !file names are "plist1.h5" and "plist2.h5" @@ -482,12 +482,12 @@ 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 + !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" @@ -540,7 +540,7 @@ 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. ! @@ -557,8 +557,8 @@ RETURN END SUBROUTINE plisttest - - + + ! ! The following subroutine tests h5pget(set)_fclose_degree_f ! @@ -567,21 +567,21 @@ USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error INTEGER :: error - + ! CHARACTER(LEN=10), PARAMETER :: filename = "file_close" - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename - INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers + 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 :: i - + CALL h5eset_auto_f(0, error) CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) @@ -652,7 +652,7 @@ total_error = total_error + 1 write(*,*) "Wrong number of open objects reported, error" endif - allocate(obj_ids(obj_countf), stat = error) + 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 @@ -661,22 +661,22 @@ 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 + 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 + 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 + endif if(cleanup) then CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) @@ -685,7 +685,7 @@ deallocate(obj_ids) RETURN - END SUBROUTINE file_close + END SUBROUTINE file_close ! ! The following subroutine tests h5fget_freespace_f @@ -696,16 +696,16 @@ IMPLICIT NONE CHARACTER(*), INTENT(IN) :: filename LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error INTEGER :: error ! CHARACTER(LEN=3), PARAMETER :: grpname = "grp" - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename - INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HID_T) :: fid ! File identifiers INTEGER(HSSIZE_T) :: free_space - INTEGER(HID_T) :: group_id ! Group identifier - + INTEGER(HID_T) :: group_id ! Group identifier + CALL h5eset_auto_f(0, error) CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) @@ -730,7 +730,7 @@ ! 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) @@ -758,7 +758,7 @@ CALL check("h5_cleanup_f", error, total_error) RETURN - END SUBROUTINE file_space + END SUBROUTINE file_space diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90 index e0270a9..300e538 100644 --- a/fortran/test/tH5G.f90 +++ b/fortran/test/tH5G.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,46 +11,46 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE group_test(cleanup, total_error) -! This subroutine tests following functionalities: +! This subroutine tests following functionalities: ! h5gcreate_f, h5gopen_f, h5gclose_f, (?)h5gget_obj_info_idx_f, h5gn_members_f ! h5glink(2)_f, h5gunlink_f, h5gmove(2)_f, h5gget_linkval_f, h5gset_comment_f, -! h5gget_comment_f +! h5gget_comment_f + + USE HDF5 ! This module contains all necessary modules - USE HDF5 ! This module contains all necessary modules - IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=5), PARAMETER :: filename = "gtest" !File name CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=33), PARAMETER :: comment = "Testing the group functionalities" + CHARACTER(LEN=33), PARAMETER :: comment = "Testing the group functionalities" ! comment for this file CHARACTER(LEN=7), PARAMETER :: groupname1 = "MyGroup" ! Group name - CHARACTER(LEN=16), PARAMETER :: groupname2 = "/MyGroup/Group_A" - CHARACTER(LEN=9), PARAMETER :: linkname1 = "hardlink1" - CHARACTER(LEN=9), PARAMETER :: linkname2 = "hardlink2" - CHARACTER(LEN=9), PARAMETER :: linkname3 = "softlink1" - CHARACTER(LEN=9), PARAMETER :: linkname4 = "softlink2" - CHARACTER(LEN=12), PARAMETER :: linkname5 = "newsoftlink2" + CHARACTER(LEN=16), PARAMETER :: groupname2 = "/MyGroup/Group_A" + CHARACTER(LEN=9), PARAMETER :: linkname1 = "hardlink1" + CHARACTER(LEN=9), PARAMETER :: linkname2 = "hardlink2" + CHARACTER(LEN=9), PARAMETER :: linkname3 = "softlink1" + CHARACTER(LEN=9), PARAMETER :: linkname4 = "softlink2" + CHARACTER(LEN=12), PARAMETER :: linkname5 = "newsoftlink2" CHARACTER(LEN=13), PARAMETER :: dsetname1 = "MyGroup/dset1" ! Dataset name CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: group1_id ! Group identifier - INTEGER(HID_T) :: group2_id ! Group identifier - INTEGER(HID_T) :: dset1_id ! Dataset identifier - INTEGER(HID_T) :: dset2_id ! Dataset identifier - INTEGER(HID_T) :: dsetnew_id ! Dataset identifier - INTEGER(HID_T) :: dspace_id ! Data space identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: group1_id ! Group identifier + INTEGER(HID_T) :: group2_id ! Group identifier + INTEGER(HID_T) :: dset1_id ! Dataset identifier + INTEGER(HID_T) :: dset2_id ! Dataset identifier + INTEGER(HID_T) :: dsetnew_id ! Dataset identifier + INTEGER(HID_T) :: dspace_id ! Data space identifier - INTEGER, DIMENSION(1) :: dset1_data = 34 ! Data value - INTEGER, DIMENSION(1) :: dset2_data = 98 ! Data value + INTEGER, DIMENSION(1) :: dset1_data = 34 ! Data value + INTEGER, DIMENSION(1) :: dset2_data = 98 ! Data value INTEGER(HSIZE_T), DIMENSION(1) :: dims = 1 ! Datasets dimensions INTEGER :: rank = 1 ! Datasets rank INTEGER :: error ! Error flag @@ -58,7 +58,7 @@ CHARACTER(LEN=100) :: name !name to put symbolic object CHARACTER(LEN=100) :: commentout !comment to the file INTEGER :: nmembers - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims ! ! Create the file. ! @@ -75,19 +75,19 @@ ! CALL h5gcreate_f(file_id, groupname1, group1_id, error) CALL check("h5gcreate_f",error,total_error) - + ! ! Create a group named "/MyGroup/Group_A" in the file. ! CALL h5gcreate_f(file_id, groupname2, group2_id, error) CALL check("h5gcreate_f",error,total_error) ! - !Create data space for the dataset. + !Create data space for the dataset. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) CALL check("h5screate_simple_f",error,total_error) ! - ! create dataset in the file. + ! create dataset in the file. ! CALL h5dcreate_f(file_id, dsetname1, H5T_NATIVE_INTEGER, dspace_id, & dset1_id, error) @@ -101,7 +101,7 @@ CALL check("h5dwrite_f",error,total_error) ! - ! create dataset2 in the Group_A. + ! create dataset2 in the Group_A. ! CALL h5dcreate_f(group2_id, dsetname2, H5T_NATIVE_INTEGER, dspace_id, & dset2_id, error) @@ -116,22 +116,22 @@ ! !Create a hard link to the group1 ! - CALL h5glink_f(file_id, H5G_LINK_HARD_F, groupname1, linkname1, error) + CALL h5glink_f(file_id, H5G_LINK_HARD_F, groupname1, linkname1, error) CALL check("h5glink_f",error,total_error) ! !Create a hard link to the group2 ! - CALL h5glink2_f(file_id, groupname2, H5G_LINK_HARD_F, file_id, linkname2, error) + CALL h5glink2_f(file_id, groupname2, H5G_LINK_HARD_F, file_id, linkname2, error) CALL check("h5glink2_f",error,total_error) ! !Create a soft link to dataset11 ! - CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname1, linkname3, error) + CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname1, linkname3, error) CALL check("h5glink_f",error,total_error) ! !Create a soft link to dataset2 ! - CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname2, linkname4, error) + CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname2, linkname4, error) CALL check("h5glink_f",error,total_error) ! !close group1 @@ -147,7 +147,7 @@ !get obj info of group1 ! ! CALL h5gget_obj_info_idx_f(file_id, linkname1, 2, name, obj_type, error) -! CALL check("h5gget_obj_info_idx_f", error, total_error) +! CALL check("h5gget_obj_info_idx_f", error, total_error) ! XXX: Fix problems with H5G_LINK_F! - QAK ! if (obj_type .ne. H5G_LINK_F) then ! write(*,*) "got object ", name, " type error ", obj_type @@ -202,7 +202,7 @@ !get the comment of dataset1 ! CALL h5gget_comment_f(file_id, dsetname1,namesize, commentout, error) - CALL check("h5gget_comment_f", error, total_error) + CALL check("h5gget_comment_f", error, total_error) if ( commentout(1:33) .ne. comment) then write(*,*) "got comment ", commentout, " is wrong" total_error = total_error +1 @@ -211,10 +211,10 @@ ! Move dataset1 to gourp2_id location ! CALL h5dclose_f(dset1_id, error) - CALL check("h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) - CALL h5gmove2_f(file_id, dsetname1, group2_id, "dset1", error) - CALL check("h5gmove2_f", error, total_error) + CALL h5gmove2_f(file_id, dsetname1, group2_id, "dset1", error) + CALL check("h5gmove2_f", error, total_error) ! ! Open dataset from the new location ! @@ -224,17 +224,17 @@ !release all the resources ! CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) + CALL check("h5fclose_f", error, total_error) CALL h5gclose_f(group1_id, error) - CALL check("h5gclose_f", error, total_error) + CALL check("h5gclose_f", error, total_error) CALL h5gclose_f(group2_id, error) - CALL check("h5gclose_f", error, total_error) + CALL check("h5gclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) - CALL check("h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dsetnew_id, error) - CALL check("h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) CALL h5sclose_f(dspace_id, error) - CALL check("h5sclose_f", error, total_error) + CALL check("h5sclose_f", error, total_error) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 index 725e21b..6a2c623 100644 --- a/fortran/test/tH5G_1_8.f90 +++ b/fortran/test/tH5G_1_8.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,17 +11,17 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE group_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */ - + INTEGER :: error, ret_total_error ! WRITE(*,*) "TESTING GROUPS" @@ -75,7 +75,7 @@ SUBROUTINE group_test(cleanup, total_error) CALL write_test_status(ret_total_error, & ' Testing deleting links by index', & total_error) - + ret_total_error = 0 CALL test_lcpl(cleanup, fapl, ret_total_error) CALL write_test_status(ret_total_error, & @@ -118,15 +118,15 @@ END SUBROUTINE group_test SUBROUTINE group_info(cleanup, fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ - INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ + INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ INTEGER :: idx_type ! /* Type of index to operate on */ @@ -144,7 +144,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5G_STORAGE_TYPE_DENSE: Indexed storage ! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure INTEGER :: nlinks ! Number of links in group - INTEGER :: max_corder ! Current maximum creation order value for group + INTEGER :: max_corder ! Current maximum creation order value for group INTEGER :: u,v ! /* Local index variables */ CHARACTER(LEN=2) :: chr2 @@ -352,7 +352,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! /* Close group created */ CALL H5Gclose_f(group_id2, error) CALL check("H5Gclose_f", error, total_error) - + ! /* Retrieve main group's information */ CALL H5Gget_info_f(group_id, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_f", error, total_error) @@ -361,11 +361,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) - + ! /* Retrieve main group's information, by name */ CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) - + ! /* Check main group's information */ CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) @@ -384,7 +384,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) valname = CORDER_GROUP_NAME//objname CALL H5Lcreate_soft_f(valname, soft_group_id, objname, error, H5P_DEFAULT_F, H5P_DEFAULT_F) - + ! /* Retrieve soft link group's information, by name */ CALL H5Gget_info_f(soft_group_id, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_f", error, total_error) @@ -401,7 +401,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(soft_group_id, error) CALL check("H5Gclose_f", error, total_error) - + ! /* Close the file */ CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) @@ -434,8 +434,8 @@ SUBROUTINE group_info(cleanup, fapl, total_error) SUBROUTINE timestamps(cleanup, fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl @@ -445,7 +445,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER(HID_T) :: group_id2 !/* Group ID */ INTEGER(HID_T) :: gcpl_id !/* Group creation property list ID */ INTEGER(HID_T) :: gcpl_id2 !/* Group creation property list ID */ - + CHARACTER(LEN=6), PARAMETER :: prefix = 'links9' CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */ ! /* Timestamp macros */ @@ -483,7 +483,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! /* Create file */ !h5_fixname(FILENAME[0], fapl, filename, sizeof filename); - + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("h5fcreate_f",error,total_error) @@ -514,7 +514,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error) CALL check("H5Pget_obj_track_times_f", error, total_error) CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error) - + ! /* Query the object information for each group */ ! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR ! if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR @@ -630,8 +630,8 @@ SUBROUTINE group_info(cleanup, fapl, total_error) SUBROUTINE mklinks(fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl @@ -642,7 +642,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: arank = 1 ! Attribure rank INTEGER :: error - INTEGER :: cset ! Indicates the character set used for the link’s name. + INTEGER :: cset ! Indicates the character set used for the link’s name. INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: @@ -663,7 +663,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("mklinks.h5screate_simple_f",error,total_error) !/* Create a group */ - CALL H5Gcreate_f(file, "grp1", grp, error) + CALL H5Gcreate_f(file, "grp1", grp, error) CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(grp, error) CALL check("h5gclose_f",error,total_error) @@ -677,7 +677,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) !/* Create a hard link */ CALL H5Lcreate_hard_f(file, "d1", INT(H5L_SAME_LOC_F,HID_T), "grp1/hard", error) CALL check("H5Lcreate_hard_f", error, total_error) - + !/* Create a symbolic link */ CALL H5Lcreate_soft_f("/d1", file, "grp1/soft",error) CALL check("H5Lcreate_soft_f", error, total_error) @@ -725,8 +725,8 @@ SUBROUTINE group_info(cleanup, fapl, total_error) SUBROUTINE test_move_preserves(fapl_id, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl_id @@ -749,7 +749,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) INTEGER :: crt_order_flags ! /* Status of creation order info for GCPL */ CHARACTER(LEN=12), PARAMETER :: filename = 'TestLinks.h5' - INTEGER :: cset ! Indicates the character set used for the link’s name. + INTEGER :: cset ! Indicates the character set used for the link’s name. INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: @@ -774,17 +774,17 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error) CALL check("H5Pget_link_creation_order_f",error, total_error) CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags,0, total_error) - + CALL H5Pset_link_creation_order_f(fcpl_id, H5P_CRT_ORDER_TRACKED_F, error) CALL check("H5Pset_link_creation_order_f", error, total_error) - + CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error) CALL check("H5Pget_link_creation_order_f",error, total_error) CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error) !/* Create file */ !/* (with creation order tracking for the root group) */ - + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file_id, error, fcpl_id, fapl_id) CALL check("h5fcreate_f",error,total_error) @@ -796,7 +796,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pset_char_encoding_f",error, total_error) !/* Create a group with that lcpl */ - CALL H5Gcreate_f(file_id, "group", group_id, error,lcpl_id=lcpl_id, gcpl_id=H5P_DEFAULT_F, gapl_id=H5P_DEFAULT_F) + CALL H5Gcreate_f(file_id, "group", group_id, error,lcpl_id=lcpl_id, gcpl_id=H5P_DEFAULT_F, gapl_id=H5P_DEFAULT_F) CALL check("H5Gcreate_f", error, total_error) CALL H5Gclose_f(group_id, error) CALL check("H5Gclose_f", error, total_error) @@ -825,7 +825,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! /* Close the file and reopen it */ CALL H5Fclose_f(file_id, error) CALL check("H5Fclose_f", error, total_error) - + !!$ if((file_id = H5Fopen(filename, H5F_ACC_RDWR, fapl_id)) < 0) TEST_ERROR !!$ !!$ /* Get the link's character set & modification time . They should be unchanged */ @@ -908,7 +908,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Pclose_f", error, total_error) CALL H5Pclose_f(lcpl_id, error) CALL check("H5Pclose_f", error, total_error) - + ! if(H5Fclose(file_id) < 0) TEST_ERROR END SUBROUTINE test_move_preserves @@ -932,8 +932,8 @@ SUBROUTINE group_info(cleanup, fapl, total_error) SUBROUTINE lifecycle(cleanup, fapl2, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl2 @@ -985,7 +985,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) ! /* Set up group creation property list */ CALL H5Pcreate_f(H5P_GROUP_CREATE_F,gcpl,error) CALL check("H5Pcreate_f",error,total_error) - + ! /* Query default group creation property settings */ CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error) @@ -1002,7 +1002,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL check("H5Pget_est_link_info_f", error, total_error) CALL verify("H5Pget_est_link_info_f", est_num_entries, H5G_CRT_GINFO_EST_NUM_ENTRIES,total_error) CALL verify("H5Pget_est_link_info_f", est_name_len, H5G_CRT_GINFO_EST_NAME_LEN,total_error) - + !/* Set GCPL parameters */ @@ -1044,7 +1044,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Ldelete_f(fid, LIFECYCLE_TOP_GROUP, error) CALL check("H5Ldelete_f", error, total_error) - + ! /* Close GCPL */ CALL H5Pclose_f(gcpl, error) CALL check("H5Pclose_f", error, total_error) @@ -1079,8 +1079,8 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) SUBROUTINE cklinks(fapl, total_error) ! USE ISO_C_BINDING - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl @@ -1116,7 +1116,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) !!$ TEST_ERROR !!$ } /* end if */ - + CALL H5Lexists_f(file,"d1",Lexists, error) CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) @@ -1148,8 +1148,8 @@ END SUBROUTINE cklinks ! */ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl @@ -1159,19 +1159,19 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ INTEGER :: idx_type ! /* Type of index to operate on */ - LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! /* Use index on creation order values */ - INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ + INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ CHARACTER(LEN=7) :: objname ! /* Object name */ CHARACTER(LEN=8) :: filename = 'file0.h5' ! /* File name */ CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" - LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name - INTEGER(SIZE_T) :: val_size + INTEGER(SIZE_T) :: val_size INTEGER :: link_type INTEGER(HADDR_T) :: address @@ -1237,7 +1237,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) ! /* Create file */ CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl) CALL check("delete_by_idx.H5Fcreate_f", error, total_error) - + ! /* Create group creation property list */ CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) CALL check("delete_by_idx.H5Pcreate_f", error, total_error) @@ -1287,7 +1287,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) ! IF(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR ! /* Check for out of bound deletion */ - htmp =9 + htmp =9 !EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error) CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error) CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) @@ -1312,7 +1312,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error) CALL check("H5Iget_type_f", error, total_error) CALL VERIFY("H5Iget_type_f", id_type, H5I_GROUP_F, total_error) - + CALL H5Gclose_f(grp, error) CALL check("H5Gclose_f", error, total_error) @@ -1389,8 +1389,8 @@ END SUBROUTINE delete_by_idx SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & hard_link, use_index, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: group_id @@ -1399,7 +1399,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & LOGICAL, INTENT(IN) :: hard_link LOGICAL, INTENT(IN) :: use_index - LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute INTEGER :: corder ! Is a positive integer containing the creation order of the attribute INTEGER :: cset ! Indicates the character set used for the attribute’s name INTEGER :: link_type @@ -1437,7 +1437,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! /* Verify value for new soft link, in increasing creation order */ !!$ IF(hard_link)THEN !!$ ! HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); -!!$ +!!$ !!$ CALL H5Lget_val_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, n, tmpval, INT(7,SIZE_T),error) !!$ CALL check("H5Lget_val_by_idx",error,total_error) !!$ @@ -1493,21 +1493,21 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & SUBROUTINE test_lcpl(cleanup, fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl LOGICAL :: cleanup - + INTEGER(HID_T) :: file_id INTEGER(HID_T) :: group_id INTEGER(HID_T) :: space_id, data_space INTEGER(HID_T) :: dset_id INTEGER(HID_T) :: type_id INTEGER(HID_T) :: lcpl_id - - INTEGER :: cset ! Indicates the character set used for the link’s name. + + INTEGER :: cset ! Indicates the character set used for the link’s name. INTEGER :: corder ! Specifies the link’s creation order position. LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. INTEGER :: link_type ! Specifies the link class: @@ -1534,25 +1534,25 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! WRITE(*,*) "link creation property lists (w/new group format)" - + !/* Actually, intermediate group creation is tested elsewhere (tmisc). ! * Here we only need to test the character encoding property */ !/* Create file */ ! h5_fixname(FILENAME[0], fapl, filename, sizeof filename); - + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) CALL check("test_lcpl.H5Fcreate_f", error, total_error) ! /* Create and link a group with the default LCPL */ - + CALL H5Gcreate_f(file_id, "/group", group_id, error) CALL check("test_lcpl.H5Gcreate_f", error, total_error) - + ! /* Check that its character encoding is the default */ - + CALL H5Lget_info_f(file_id, "group", & cset, corder, f_corder_valid, link_type, address, val_size, & error, H5P_DEFAULT_F) @@ -1570,7 +1570,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL check("test_lcpl.h5tcommit_f", error, total_error) CALL h5tclose_f(type_id, error) CALL check("test_lcpl.h5tclose_f", error, total_error) - + ! /* Check that its character encoding is the default */ CALL H5Lget_info_f(file_id, "type", & @@ -1613,7 +1613,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL h5sget_simple_extent_dims_f(data_space, dimsout, maxdimsout, error) CALL check("test_lcpl.h5sget_simple_extent_dims_f",error, total_error) - + DO i = 1, 2 tmp1 = dimsout(i) tmp2 = extend_dim(i) @@ -1628,7 +1628,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! /* close data set */ CALL h5dclose_f(dset_id, error) - CALL check("test_lcpl.h5dclose_f", error, total_error) + CALL check("test_lcpl.h5dclose_f", error, total_error) ! /* Check that its character encoding is the default */ CALL H5Lget_info_f(file_id, "dataset", & @@ -1689,7 +1689,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & CALL H5Pget_char_encoding_f(lcpl_id, encoding, error) CALL check("test_lcpl.H5Pget_char_encoding_f", error, total_error) - CALL VERIFY("test_lcpl.H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) + CALL VERIFY("test_lcpl.H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) ! /* Check that its character encoding is UTF-8 */ CALL H5Lget_info_f(file_id, "dataset2", & @@ -1718,7 +1718,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & cset, corder, f_corder_valid, link_type, address, val_size, & error) CALL check("test_lcpl.H5Lget_info_f", error, total_error) - CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) ! /* Check that the first link's encoding hasn't changed */ @@ -1731,7 +1731,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & !/* Make sure that LCPLs work properly for other API calls: */ !/* H5Lcreate_soft */ - + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) CALL H5Lcreate_soft_f("dataset2", file_id, "slink_to_dset2",error,lcpl_id) @@ -1759,12 +1759,12 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & ! /* H5Lcopy */ - + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) CALL H5Lcopy_f(file_id, "moved_slink", file_id, "copied_slink", error, lcpl_id) - + CALL H5Lget_info_f(file_id, "copied_slink", & cset, corder, f_corder_valid, link_type, address, val_size, & error) @@ -1801,8 +1801,8 @@ END SUBROUTINE test_lcpl SUBROUTINE objcopy(fapl, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER(HID_T), INTENT(IN) :: fapl @@ -1821,13 +1821,13 @@ SUBROUTINE objcopy(fapl, total_error) !/* Set the "use the latest version of the format" bounds for creating objects in the file */ CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) - + ! /* create property to pass copy options */ CALL h5pcreate_f(H5P_OBJECT_COPY_F, pid, error) CALL check("h5pcreate_f",error, total_error) ! /* set options for object copy */ - CALL H5Pset_copy_object_f(pid, flag, error) + CALL H5Pset_copy_object_f(pid, flag, error) CALL check("H5Pset_copy_object_f",error, total_error) ! /* Verify object copy flags */ @@ -1836,7 +1836,7 @@ SUBROUTINE objcopy(fapl, total_error) CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error) !!$ -!!$ CALL test_copy_option(fcpl_src, fcpl_dst, my_fapl, H5O_COPY_WITHOUT_ATTR_FLAG, +!!$ CALL test_copy_option(fcpl_src, fcpl_dst, my_fapl, H5O_COPY_WITHOUT_ATTR_FLAG, !!$ FALSE, "H5Ocopy(): without attributes"); CALL lapl_nlinks(fapl2, total_error) @@ -1865,7 +1865,7 @@ END SUBROUTINE objcopy SUBROUTINE lapl_nlinks( fapl, total_error) USE HDF5 - + IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: fapl INTEGER, INTENT(INOUT) :: total_error @@ -1877,13 +1877,13 @@ SUBROUTINE lapl_nlinks( fapl, total_error) INTEGER(HID_T) :: plist = (-1) ! /* lapl ID */ INTEGER(HID_T) :: tid = (-1) ! /* Other IDs */ INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! /* Other property lists */ - + CHARACTER(LEN=7) :: objname ! /* Object name */ INTEGER(size_t) :: name_len ! /* Length of object name */ CHARACTER(LEN=12) :: filename = 'TestLinks.h5' INTEGER(size_t) :: nlinks ! /* nlinks for H5Pset_nlinks */ INTEGER(size_t) :: buf_size = 7 - + ! WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)" @@ -1892,9 +1892,9 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL check(" lapl_nlinks.h5fcreate_f",error,total_error) ! /* Create group with short name in file (used as target for links) */ - CALL H5Gcreate_f(fid, "final", gid, error) + CALL H5Gcreate_f(fid, "final", gid, error) CALL check(" lapl_nlinks.H5Gcreate_f", error, total_error) - + !/* Create chain of soft links to existing object (limited) */ CALL H5Lcreate_soft_f("final", fid, "soft1", error) CALL H5Lcreate_soft_f("soft1", fid, "soft2", error) @@ -1921,13 +1921,13 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL check("h5fclose_f",error,total_error) !/* Open file */ - + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) CALL check("h5open_f",error,total_error) - + !/* Create LAPL with higher-than-usual nlinks value */ !/* Create a non-default lapl with udata set to point to the first group */ - + CALL H5Pcreate_f(H5P_LINK_ACCESS_F,plist,error) CALL check("h5Pcreate_f",error,total_error) nlinks = 20 @@ -1942,7 +1942,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !/* Open object through what is normally too many soft links using ! * new property list */ - + CALL H5Oopen_f(fid,"soft17",gid,error,plist) CALL check("H5Oopen_f",error,total_error) @@ -1954,9 +1954,9 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL H5Gcreate_f(gid, "new_soft", gid2, error) CALL check("H5Gcreate_f", error, total_error) - ! /* Close groups */ + ! /* Close groups */ CALL H5Gclose_f(gid2, error) - CALL check("H5Gclose_f", error, total_error) + CALL check("H5Gclose_f", error, total_error) CALL H5Gclose_f(gid, error) CALL check("H5Gclose_f", error, total_error) @@ -1974,7 +1974,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error) ! /* Try opening through what is now too many soft links */ - + CALL H5Oopen_f(fid,"soft5",gid,error,plist) CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail @@ -2064,11 +2064,11 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ } H5E_END_TRY !!$ ! /* Create property lists with nlinks set */ - + CALL H5Pcreate_f(H5P_GROUP_ACCESS_F,gapl,error) - CALL check("h5Pcreate_f",error,total_error) + CALL check("h5Pcreate_f",error,total_error) CALL H5Pcreate_f(H5P_DATATYPE_ACCESS_F,tapl,error) - CALL check("h5Pcreate_f",error,total_error) + CALL check("h5Pcreate_f",error,total_error) CALL H5Pcreate_f(H5P_DATASET_ACCESS_F,dapl,error) CALL check("h5Pcreate_f",error,total_error) @@ -2090,11 +2090,11 @@ SUBROUTINE lapl_nlinks( fapl, total_error) CALL H5Topen_f(fid, "soft17/datatype", tid, error, tapl) CALL check("H5Gopen_f",error,total_error) - + !!$ if((did = H5Dopen2(fid, "soft17/dataset", dapl)) < 0) TEST_ERROR ! /* Close objects */ - + CALL h5gclose_f(gid, error) CALL check("h5gclose_f",error,total_error) CALL h5tclose_f(tid, error) @@ -2103,7 +2103,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error) !!$ if(H5Dclose(did) < 0) TEST_ERROR !!$ ! /* Close plists */ - + CALL h5pclose_f(gapl, error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(tapl, error) diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90 index c34bd09..0d1a8c5 100644 --- a/fortran/test/tH5I.f90 +++ b/fortran/test/tH5I.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,38 +11,38 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE identifier_test(cleanup, total_error) ! This subroutine tests following functionalities: h5iget_type_f - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=6), PARAMETER :: filename = "itestf" ! File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=10), PARAMETER :: dsetname = "/itestdset" ! Dataset name CHARACTER(LEN=10), PARAMETER :: groupname = "itestgroup"! group name CHARACTER(LEN=10), PARAMETER :: aname = "itestattr"! group name - - + + INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: new_file_id ! File identifier - INTEGER(HID_T) :: group_id ! group identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: group_id ! group identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: attr_id ! Datatype attribute identifier INTEGER(HID_T) :: aspace_id ! attribute data space identifier INTEGER(HID_T) :: atype_id ! attribute data type identifier - INTEGER, DIMENSION(1) :: dset_data = 0 ! Data value - + INTEGER, DIMENSION(1) :: dset_data = 0 ! Data value + INTEGER(HSIZE_T), DIMENSION(1) :: dims = 1 ! Datasets dimensions INTEGER(HSIZE_T), DIMENSION(1) :: adims = 1 ! Attribute dimensions @@ -69,24 +69,24 @@ ! check that the ID is not valid dtype = -1 CALL H5Iis_valid_f(dtype, tri_ret, error) - CALL check("H5Iis_valid_f", error, total_error) + CALL check("H5Iis_valid_f", error, total_error) CALL VerifyLogical("H5Iis_valid_f", tri_ret, .FALSE., total_error) - + ! Create a datatype id CALL H5Tcopy_f(H5T_NATIVE_INTEGER,dtype,error) - CALL check("H5Tcopy_f", error, total_error) - + CALL check("H5Tcopy_f", error, total_error) + ! Check that the ID is valid CALL H5Iis_valid_f(dtype, tri_ret, error) - CALL check("H5Iis_valid_f", error, total_error) + CALL check("H5Iis_valid_f", error, total_error) CALL VerifyLogical("H5Tequal_f", tri_ret, .TRUE., total_error) - + CALL H5Tclose_f(dtype, error) - CALL check("H5Tclose_f", error, total_error) - + CALL check("H5Tclose_f", error, total_error) + ! ! Create a new file using default properties. - ! + ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" @@ -94,7 +94,7 @@ endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - + ! ! Create a group named "/MyGroup" in the file. ! @@ -102,20 +102,20 @@ CALL check("h5gcreate_f",error,total_error) ! - !Create data space for the dataset. + !Create data space for the dataset. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) CALL check("h5screate_simple_f",error,total_error) ! - ! create dataset in the file. + ! create dataset in the file. ! CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & dset_id, error) CALL check("h5dcreate_f",error,total_error) ! ! Get dataset name from dataset identifier - ! + ! buf_size = 80 CALL h5iget_name_f(dset_id, name_buf, buf_size, name_size, error) CALL check("h5iget_name_f",error,total_error) @@ -128,8 +128,8 @@ total_error = total_error + 1 endif endif - - ! + + ! ! Get file identifier from dataset identifier and then get file name ! CALL h5iget_file_id_f(dset_id, new_file_id, error) @@ -150,7 +150,7 @@ CALL check("h5dwrite_f",error,total_error) ! - ! Create scalar data space for dataset attribute. + ! Create scalar data space for dataset attribute. ! CALL h5screate_simple_f(arank, adims, aspace_id, error) CALL check("h5screate_simple_f",error,total_error) @@ -215,37 +215,37 @@ CALL check("h5iget_type_f",error,total_error) CALL verify("get attribute identifier wrong",type,H5I_ATTR_F,total_error) - ! + ! ! Close the attribute. - ! + ! CALL h5aclose_f(attr_id, error) CALL check("h5aclose_f",error,total_error) - ! + ! ! Close the dataspace. - ! + ! CALL h5sclose_f(aspace_id, error) CALL check("h5sclose_f",error,total_error) CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f",error,total_error) - ! + ! ! Close the dataype. - ! + ! CALL h5tclose_f(atype_id, error) CALL check("h5tclose_f",error,total_error) - ! + ! ! Close the dataset. - ! + ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f",error,total_error) - ! + ! ! Close the group. - ! + ! CALL h5gclose_f(group_id, error) CALL check("h5gclose_f",error,total_error) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -260,7 +260,7 @@ ! Create a file CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - + ! Get the reference count for the file ID CALL h5iget_ref_f(file_id, ref_count, error) CALL check("h5iget_ref_f",error,total_error) diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90 index 0aa4abd..253a42a 100644 --- a/fortran/test/tH5O.f90 +++ b/fortran/test/tH5O.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,11 +11,11 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE test_h5o(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error @@ -35,7 +35,7 @@ SUBROUTINE test_h5o(cleanup, total_error) CALL check("h5_cleanup_f", error, total_error) IF(cleanup) CALL h5_cleanup_f("test", H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + END SUBROUTINE test_h5o !/**************************************************************** @@ -46,8 +46,8 @@ END SUBROUTINE test_h5o SUBROUTINE test_h5o_link(total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error @@ -79,7 +79,7 @@ SUBROUTINE test_h5o_link(total_error) wdata(i,j) = i*j ENDDO ENDDO - + ! /* Create the dataspace */ CALL h5screate_simple_f(2, dims, space_id, error) CALL check("h5screate_simple_f",error,total_error) @@ -97,14 +97,14 @@ SUBROUTINE test_h5o_link(total_error) !/* Make a FAPL that uses the "use the latest version of the format" bounds */ CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,error) CALL check("h5Pcreate_f",error,total_error) - + ! /* Set the "use the latest version of the format" bounds for creating objects in the file */ - + CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) CALL check("H5Pset_libver_bounds_f",error, total_error) - + !!$ ret = H5Pset_libver_bounds(fapl_id, (new_format ? H5F_LIBVER_LATEST : H5F_LIBVER_EARLIEST), H5F_LIBVER_LATEST); - + ! /* Create a new HDF5 file */ CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) CALL check("H5Fcreate_f", error, total_error) @@ -112,11 +112,11 @@ SUBROUTINE test_h5o_link(total_error) ! /* Close the FAPL */ CALL h5pclose_f(fapl_id, error) CALL check("h5pclose_f",error,total_error) - + ! /* Create and commit a datatype with no name */ CALL H5Tcopy_f( H5T_NATIVE_INTEGER, type_id, error) CALL check("H5Tcopy_F",error,total_error) - + CALL H5Tcommit_anon_f(file_id, type_id, error) ! using no optional parameters CALL check("H5Tcommit_anon_F",error,total_error) @@ -130,7 +130,7 @@ SUBROUTINE test_h5o_link(total_error) ! /* Verify that we can write to and read from the dataset */ - + ! /* Write the data to the dataset */ !EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, & @@ -143,7 +143,7 @@ SUBROUTINE test_h5o_link(total_error) !EP mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error) CALL check("h5dread_f", error, total_error) - + ! /* Verify the data */ DO i = 1, TEST6_DIM1 DO j = 1, TEST6_DIM2 @@ -175,17 +175,17 @@ SUBROUTINE test_h5o_link(total_error) ! /* Re-open datatype using new link */ CALL H5Topen_f(group_id, "datatype", type_id, error) CALL check("h5topen_f", error, total_error) - + ! /* Link nameless group to root group and close the group ID*/ CALL H5Olink_f(group_id, file_id, "/group", error) CALL check("H5Olink_f", error, total_error) - + CALL h5gclose_f(group_id, error) CALL check("h5gclose_f",error,total_error) ! /* Open dataset through root group and verify its data */ - + CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error) CALL check("test_lcpl.h5dopen_f", error, total_error) @@ -227,8 +227,8 @@ END SUBROUTINE test_h5o_link SUBROUTINE test_h5o_plist(total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE INTEGER, INTENT(OUT) :: total_error @@ -240,7 +240,7 @@ SUBROUTINE test_h5o_plist(total_error) INTEGER :: max_compact, min_dense !/* Actual phase change parameters */ INTEGER :: error !/* Value returned from API calls */ CHARACTER(LEN=7), PARAMETER :: TEST_FILENAME = 'test.h5' - + ! PRINT*,'Testing object creation properties' @@ -275,7 +275,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL check("H5Pget_attr_phase_change_f", error, total_error) CALL H5Pset_attr_phase_change_f(tcpl, def_max_compact+1, def_min_dense-1, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) - + ! /* Retrieve attribute phase change values on each creation property list and verify */ CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error) CALL check("H5Pget_attr_phase_change_f", error, total_error) @@ -307,7 +307,7 @@ SUBROUTINE test_h5o_plist(total_error) ! /* Commit the type inside the group anonymously and link it in */ CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error) CALL check("h5tcopy_f", error, total_error) - + CALL H5Tcommit_anon_f(fid, dtype, error, tcpl_id=tcpl) CALL check("H5Tcommit_anon_f",error,total_error) @@ -321,7 +321,7 @@ SUBROUTINE test_h5o_plist(total_error) ! /* Create the dataset anonymously and link it in */ CALL H5Dcreate_anon_f(fid, H5T_NATIVE_INTEGER, dspace, dset, error, dcpl ) CALL check("H5Dcreate_anon_f",error,total_error) - + CALL H5Olink_f(dset, fid, "dataset", error) CALL check("H5Olink_f", error, total_error) @@ -338,7 +338,7 @@ SUBROUTINE test_h5o_plist(total_error) CALL check("h5pclose_f", error, total_error) ! /* Retrieve each object's creation property list */ - + CALL H5Gget_create_plist_f(grp, gcpl, error) CALL check("H5Gget_create_plist", error, total_error) @@ -367,7 +367,7 @@ SUBROUTINE test_h5o_plist(total_error) !/* Close current objects */ - + CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) @@ -427,7 +427,7 @@ SUBROUTINE test_h5o_plist(total_error) ! /* Close current objects */ - + CALL h5pclose_f(gcpl,error) CALL check("h5pclose_f", error, total_error) CALL h5pclose_f(dcpl,error) diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 3063842..6a49f72 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,25 +11,25 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE external_test(cleanup, total_error) -! This subroutine tests following functionalities: +! This subroutine tests following functionalities: ! h5pset_external_f, h5pget_external_count_f, ! h5pget_external_f - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + 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) :: 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 @@ -38,7 +38,7 @@ 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 + 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 @@ -51,7 +51,7 @@ ! !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" @@ -80,7 +80,7 @@ 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); + 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) @@ -88,7 +88,7 @@ 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) @@ -100,8 +100,8 @@ 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 + + ! 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) @@ -123,7 +123,7 @@ 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) @@ -136,27 +136,27 @@ 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 + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=9), PARAMETER :: filename = "multidset" ! File name - CHARACTER(LEN=80) :: fix_filename + 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) :: 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 + 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. @@ -208,7 +208,7 @@ ! ! 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" @@ -227,19 +227,19 @@ write(*,*) "Wrong value for driver" endif ! - ! Let's check h5pget(set)cache_f APIs here for now + ! 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 @@ -247,10 +247,10 @@ total_error = 1 call h5pclose_f(fapl, error) return - endif + endif - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) @@ -268,14 +268,14 @@ ! Write the dataset. ! data_dims(1) = 4 - data_dims(2) = 6 + 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) @@ -285,14 +285,14 @@ 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) @@ -314,19 +314,19 @@ ! CALL check("h5pget_fapl_multi_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) ! - ! Get the dataset type. + ! 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. + ! Get the data space. ! CALL h5dget_space_f(dset_id, dspace_id, error) CALL check("h5dget_space_f", error, total_error) @@ -339,19 +339,19 @@ ! !Compare the data. - ! + ! do i = 1, 4 do j = 1, 6 - IF (data_out(i,j) .NE. dset_data(i, j)) THEN + 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 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) @@ -366,7 +366,7 @@ ! CALL h5tclose_f(dtype_id, error) CALL check("h5tclose_f", error, total_error) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -377,7 +377,7 @@ 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) @@ -390,7 +390,7 @@ 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 @@ -412,14 +412,14 @@ ! April 16, 2009 !------------------------------------------------------------------------- ! -SUBROUTINE test_chunk_cache(cleanup, total_error) +SUBROUTINE test_chunk_cache(cleanup, total_error) + + USE HDF5 ! This module contains all necessary modules - USE HDF5 ! This module contains all necessary modules - 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 */ @@ -457,7 +457,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Verify that H5Pget_chunk_cache(dapl) returns the same values as are in ! the default fapl. - ! + ! CALL H5Pget_cache_f(fapl_def, mdc_nelmts, nslots_1, nbytes_1, w0_1, error) CALL check("H5Pget_cache_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl1, nslots_4, nbytes_4, w0_4, error) @@ -514,7 +514,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! /* 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 */ CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) @@ -526,7 +526,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF 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 @@ -601,7 +601,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) CALL check("H5Pset_cache_f", error, total_error) ! Close and reopen file with new fapl_local - + CALL H5Dclose_f(dsid, error); CALL check("H5Dclose_f", error, total_error) CALL H5Fclose_f(fid,error); CALL check("h5fclose_f", error, total_error) @@ -611,12 +611,12 @@ SUBROUTINE test_chunk_cache(cleanup, total_error) ! Verify that dapl2 retrieved earlier (using values from the old fapl) ! sets its values in the new file (test use of H5Dopen2 with a dapl) ! - + CALL h5dopen_f (fid, "dset", dsid, error, dapl2) CALL check("h5dopen_f", error, total_error) - + CALL H5Pclose_f(dapl2,error); CALL check("H5Pclose_f", error, total_error) ! Close dapl2, to avoid id leak - + CALL H5Dget_access_plist_f(dsid, dapl2, error) CALL check("H5Dget_access_plist_f", error, total_error) CALL H5Pget_chunk_cache_f(dapl2, nslots_4, nbytes_4, w0_4, error) @@ -654,11 +654,11 @@ SUBROUTINE test_chunk_cache(cleanup, 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 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) diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90 index adcdfc7..0289465 100644 --- a/fortran/test/tH5R.f90 +++ b/fortran/test/tH5R.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,56 +11,56 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Reference Interface functionality. ! ! The following subroutine tests h5rcreate_f, h5rdereference_f, h5rget_name_f ! and H5Rget_object_type functions ! SUBROUTINE refobjtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=9), PARAMETER :: filename = "reference" CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=8), PARAMETER :: dsetnamei = "INTEGERS" CHARACTER(LEN=17), PARAMETER :: dsetnamer = "OBJECT_REFERENCES" CHARACTER(LEN=6), PARAMETER :: groupname1 = "GROUP1" CHARACTER(LEN=6), PARAMETER :: groupname2 = "GROUP2" - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: grp1_id ! Group identifier - INTEGER(HID_T) :: grp2_id ! Group identifier - INTEGER(HID_T) :: dset1_id ! Dataset identifier - INTEGER(HID_T) :: dsetr_id ! Dataset identifier - INTEGER(HID_T) :: type_id ! Type identifier - INTEGER(HID_T) :: space_id ! Dataspace identifier - INTEGER(HID_T) :: spacer_id ! Dataspace identifier + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: grp1_id ! Group identifier + INTEGER(HID_T) :: grp2_id ! Group identifier + INTEGER(HID_T) :: dset1_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER(HID_T) :: type_id ! Type identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier INTEGER :: error, obj_type INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/5/) INTEGER(HSIZE_T), DIMENSION(1) :: dimsr= (/4/) INTEGER(HSIZE_T), DIMENSION(1) :: my_maxdims = (/5/) - INTEGER :: rank = 1 - INTEGER :: rankr = 1 + INTEGER :: rank = 1 + INTEGER :: rankr = 1 TYPE(hobj_ref_t_f), DIMENSION(4) :: ref TYPE(hobj_ref_t_f), DIMENSION(4) :: ref_out INTEGER(HSIZE_T), DIMENSION(1) :: ref_dim INTEGER, DIMENSION(5) :: DATA = (/1, 2, 3, 4, 5/) INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - + CHARACTER(LEN=7) :: buf ! buffer to hold the region name CHARACTER(LEN=16) :: buf_big ! buffer bigger then needed CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name - + ! !Create a new file with Default file access and - !file creation properties . + !file creation properties . ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) IF (error .NE. 0) THEN @@ -69,28 +69,28 @@ SUBROUTINE refobjtest(cleanup, total_error) ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) - - + + ! ! Create a group inside the file ! CALL h5gcreate_f(file_id, groupname1, grp1_id, error) CALL check("h5gcreate_f",error,total_error) - + ! ! Create a group inside the group GROUP1 ! CALL h5gcreate_f(grp1_id, groupname2, grp2_id, error) CALL check("h5gcreate_f",error,total_error) - - ! - ! Create dataspaces for datasets + + ! + ! Create dataspaces for datasets ! CALL h5screate_simple_f(rank, dims, space_id, error, maxdims=my_maxdims) CALL check("h5screate_simple_f",error,total_error) CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) CALL check("h5screate_simple_f",error,total_error) - + ! ! Create integer dataset ! @@ -110,13 +110,13 @@ SUBROUTINE refobjtest(cleanup, total_error) CALL check("h5tcopy_f",error,total_error) CALL h5tcommit_f(file_id, "MyType", type_id, error) CALL check("h5tcommit_f",error,total_error) - + ! ! Close dataspaces, groups and integer dataset - ! + ! CALL h5sclose_f(space_id, error) CALL check("h5sclose_f",error,total_error) - CALL h5sclose_f(spacer_id, error) + CALL h5sclose_f(spacer_id, error) CALL check("h5sclose_f",error,total_error) CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f",error,total_error) @@ -126,7 +126,7 @@ SUBROUTINE refobjtest(cleanup, total_error) CALL check("h5gclose_f",error,total_error) CALL h5gclose_f(grp2_id, error) CALL check("h5gclose_f",error,total_error) - + ! ! Craete references to two groups, integer dataset and shared datatype ! and write it to the dataset in the file @@ -142,37 +142,37 @@ SUBROUTINE refobjtest(cleanup, total_error) ref_dim(1) = SIZE(ref) CALL h5dwrite_f(dsetr_id, H5T_STD_REF_OBJ, ref, ref_dim, error) CALL check("h5dwrite_f",error,total_error) - + ! getting path to normal dataset in root group - + CALL H5Rget_name_f(dsetr_id, ref(1), buf, error, buf_size ) CALL check("H5Rget_name_f", error, total_error) - + CALL VERIFY("H5Rget_name_f", INT(buf_size),7, total_error) CALL VerifyString("H5Rget_name_f", buf, "/GROUP1", total_error) - + ! with buffer bigger then needed - + CALL H5Rget_name_f(dsetr_id, ref(1), buf_big, error, buf_size ) CALL check("H5Rget_name_f", error, total_error) CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error) CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error) - + ! getting path to dataset in /Group1 - + CALL H5Rget_name_f(dsetr_id, ref(2), buf_big, error, buf_size ) CALL check("H5Rget_name_f", error, total_error) CALL VERIFY("H5Rget_name_f", INT(buf_size),14,total_error) CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error) - + ! !Close the dataset - ! + ! CALL h5dclose_f(dsetr_id, error) CALL check("h5dclose_f",error,total_error) - - ! + + ! ! Reopen the dataset with object references ! CALL h5dopen_f(file_id, dsetnamer,dsetr_id,error) @@ -180,60 +180,60 @@ SUBROUTINE refobjtest(cleanup, total_error) ref_dim(1) = SIZE(ref_out) CALL h5dread_f(dsetr_id, H5T_STD_REF_OBJ, ref_out, ref_dim, error) CALL check("h5dread_f",error,total_error) - + ! !get the third reference's type and Dereference it ! - CALL h5rget_object_type_f(dsetr_id, ref(3), obj_type, error) + CALL h5rget_object_type_f(dsetr_id, ref(3), obj_type, error) CALL check("h5rget_object_type_f",error,total_error) - IF (obj_type == H5G_DATASET_F) THEN + IF (obj_type == H5G_DATASET_F) THEN CALL h5rdereference_f(dsetr_id, ref(3), dset1_id, error) CALL check("h5rdereference_f",error,total_error) - + data_dims(1) = 5 CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, DATA, data_dims, error) CALL check("h5dwrite_f",error,total_error) END IF - + ! !get the fourth reference's type and Dereference it ! - CALL h5rget_object_type_f(dsetr_id, ref(4), obj_type, error) + CALL h5rget_object_type_f(dsetr_id, ref(4), obj_type, error) CALL check("h5rget_object_type_f",error,total_error) - IF (obj_type == H5G_TYPE_F) THEN + IF (obj_type == H5G_TYPE_F) THEN CALL h5rdereference_f(dsetr_id, ref(4), type_id, error) CALL check("h5rdereference_f",error,total_error) END IF - + ! ! Close all objects. - ! + ! CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f",error,total_error) CALL h5tclose_f(type_id, error) CALL check("h5tclose_f",error,total_error) - + CALL h5dclose_f(dsetr_id, error) CALL check("h5dclose_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 refobjtest ! ! The following subroutine tests h5rget_region_f, h5rcreate_f, h5rget_name_f, ! and h5rdereference_f functionalities -! +! SUBROUTINE refregtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=6), PARAMETER :: filename = "Refreg" CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=6), PARAMETER :: dsetnamev = "MATRIX" @@ -243,24 +243,24 @@ SUBROUTINE refregtest(cleanup, total_error) CHARACTER(LEN=11) :: buf_big ! buffer bigger then needed CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: space_id ! Dataspace identifier - INTEGER(HID_T) :: spacer_id ! Dataspace identifier - INTEGER(HID_T) :: dsetv_id ! Dataset identifier - INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier + INTEGER(HID_T) :: dsetv_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier INTEGER :: error TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref ! Buffers to store references TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref_out ! INTEGER(HSIZE_T), DIMENSION(2) :: ref_dim INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! INTEGER(HSIZE_T), DIMENSION(2) :: start INTEGER(HSIZE_T), DIMENSION(2) :: count - INTEGER :: rankr = 1 + INTEGER :: rankr = 1 INTEGER :: rank = 2 - INTEGER , DIMENSION(2,9) :: DATA - INTEGER , DIMENSION(2,9) :: data_out = 0 + INTEGER , DIMENSION(2,9) :: DATA + INTEGER , DIMENSION(2,9) :: data_out = 0 INTEGER(HSIZE_T) , DIMENSION(2,3) :: coord INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points coord = RESHAPE((/1,1,2,7,1,9/), (/2,3/)) ! Coordinates of selected points @@ -281,30 +281,30 @@ SUBROUTINE refregtest(cleanup, total_error) ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) ! Default file access and file creation - ! properties are used. + ! properties are used. CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create dataspaces: - ! - ! for dataset with references to dataset regions + ! + ! for dataset with references to dataset regions ! CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) CALL check("h5screate_simple_f", error, total_error) ! - ! for integer dataset + ! for integer dataset ! CALL h5screate_simple_f(rank, dims, space_id, error) CALL check("h5screate_simple_f", error, total_error) ! ! Create and write datasets: ! - ! Integer dataset + ! Integer dataset ! CALL h5dcreate_f(file_id, dsetnamev, H5T_NATIVE_INTEGER, space_id, & dsetv_id, error) CALL check("h5dcreate_f", error, total_error) data_dims(1) = 2 - data_dims(2) = 9 + data_dims(2) = 9 CALL h5dwrite_f(dsetv_id, H5T_NATIVE_INTEGER, DATA, data_dims, error) CALL check("h5dwrite_f", error, total_error) @@ -319,14 +319,14 @@ SUBROUTINE refregtest(cleanup, total_error) ! ! Create a reference to the hyperslab selection. ! - start(1) = 0 - start(2) = 3 + start(1) = 0 + start(2) = 3 COUNT(1) = 2 COUNT(2) = 3 CALL h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, & - start, count, error) + start, count, error) CALL check("h5sselect_hyperslab_f", error, total_error) - CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) CALL check("h5rcreate_f", error, total_error) ! ! Create a reference to elements selection. @@ -334,15 +334,15 @@ SUBROUTINE refregtest(cleanup, total_error) CALL h5sselect_none_f(space_id, error) CALL check("h5sselect_none_f", error, total_error) CALL h5sselect_elements_f(space_id, H5S_SELECT_SET_F, rank, num_points,& - coord, error) + coord, error) CALL check("h5sselect_elements_f", error, total_error) - CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(2), error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(2), error) CALL check("h5rcreate_f", error, total_error) ! - ! Write dataset with the references. + ! Write dataset with the references. ! ref_dim(1) = SIZE(ref) - CALL h5dwrite_f(dsetr_id, H5T_STD_REF_DSETREG, ref, ref_dim, error) + CALL h5dwrite_f(dsetr_id, H5T_STD_REF_DSETREG, ref, ref_dim, error) CALL check("h5dwrite_f", error, total_error) ! ! Close all objects. @@ -366,7 +366,7 @@ SUBROUTINE refregtest(cleanup, total_error) ! Read references to the dataset regions. ! ref_dim(1) = SIZE(ref_out) - CALL h5dread_f(dsetr_id, H5T_STD_REF_DSETREG, ref_out, ref_dim, error) + CALL h5dread_f(dsetr_id, H5T_STD_REF_DSETREG, ref_out, ref_dim, error) CALL check("h5dread_f", error, total_error) @@ -391,12 +391,12 @@ SUBROUTINE refregtest(cleanup, total_error) CALL VERIFY("H5Rget_name_f", INT(buf_size),7,total_error) CALL VerifyString("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error) - ! + ! ! Dereference the first reference. - ! + ! CALL H5rdereference_f(dsetr_id, ref_out(1), dsetv_id, error) CALL check("h5rdereference_f", error, total_error) - CALL H5rget_region_f(dsetr_id, ref_out(1), space_id, error) + CALL H5rget_region_f(dsetr_id, ref_out(1), space_id, error) CALL check("h5rget_region_f", error, total_error) ! Get name of the dataset the second region reference points to using H5Rget_name_f @@ -418,13 +418,13 @@ SUBROUTINE refregtest(cleanup, total_error) CALL h5dclose_f(dsetv_id, error) CALL check("h5dclose_f", error, total_error) data_out = 0 - ! + ! ! Dereference the second reference. - ! + ! CALL H5rdereference_f(dsetr_id, ref_out(2), dsetv_id, error) CALL check("h5rdereference_f", error, total_error) - CALL H5rget_region_f(dsetr_id, ref_out(2), space_id, error) + CALL H5rget_region_f(dsetr_id, ref_out(2), space_id, error) CALL check("h5rget_region_f", error, total_error) ! ! Read selected data from the dataset. diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90 index 63efe5f..29943bb 100644 --- a/fortran/test/tH5S.f90 +++ b/fortran/test/tH5S.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,35 +11,35 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Dataspace Interface functionality. ! ! ! The following subroutine tests the following functionalities: -! h5screate_f, h5scopy_f, h5screate_simple_f, h5sis_simple_f, -! h5sget_simple_extent_dims_f,h5sget_simple_extent_ndims_f +! h5screate_f, h5scopy_f, h5screate_simple_f, h5sis_simple_f, +! h5sget_simple_extent_dims_f,h5sget_simple_extent_ndims_f ! h5sget_simple_extent_npoints_f, h5sget_simple_extent_type_f, -! h5sextent_copy_f, h5sset_extent_simple_f, h5sset_extent_none_f +! h5sextent_copy_f, h5sset_extent_simple_f, h5sset_extent_none_f ! SUBROUTINE dataspace_basic_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=10), PARAMETER :: filename1 = "basicspace" ! File1 name CHARACTER(LEN=9), PARAMETER :: filename2 = "copyspace" ! File2 name - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=80) :: fix_filename2 + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=80) :: fix_filename2 CHARACTER(LEN=9), PARAMETER :: dsetname = "basicdset" ! Dataset name - INTEGER(HID_T) :: file1_id, file2_id ! File identifiers - INTEGER(HID_T) :: dset1_id, dset2_id ! Dataset identifiers + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: dset1_id, dset2_id ! Dataset identifiers INTEGER(HID_T) :: space1_id, space2_id ! Dataspace identifiers INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/4,6/) ! Dataset dimensions @@ -81,10 +81,10 @@ ! ! CALL h5init_types_f(error) ! CALL check("h5init_types_f", error, total_error) - + ! ! Create new files using default properties. - ! + ! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" @@ -101,53 +101,53 @@ CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create dataspace for file1. ! CALL h5screate_simple_f(rank1, dims1, space1_id, error, maxdims1) CALL check("h5screate_simple_f", error, total_error) - ! + ! ! Copy space1_id to space2_id. ! CALL h5scopy_f(space1_id, space2_id, error) CALL check("h5scopy_f", error, total_error) - ! + ! !Check whether copied space is simple. ! CALL h5sis_simple_f(space2_id, flag, error) CALL check("h5sissimple_f", error, total_error) IF (.NOT. flag) write(*,*) "dataspace is not simple type" - - ! + + ! !set the copied space to none. ! CALL h5sset_extent_none_f(space2_id, error) CALL check("h5sset_extent_none_f", error, total_error) - - ! + + ! !copy the extent of space1_id to space2_id. ! - CALL h5sextent_copy_f(space2_id, space1_id, error) + CALL h5sextent_copy_f(space2_id, space1_id, error) CALL check("h5sextent_copy_f", error, total_error) - ! + ! !get the copied space's dimensions. ! CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error) CALL check("h5sget_simple_extent_dims_f", error, total_error) IF ((dimsout(1) .NE. dims1(1)) .OR. (dimsout(2) .NE. dims1(2)) ) THEN - write(*,*)"error occured, copied dims not same" + write(*,*)"error occured, copied dims not same" END IF - - ! + + ! !get the copied space's rank. ! CALL h5sget_simple_extent_ndims_f(space2_id, rank2, error) CALL check("h5sget_simple_extent_ndims_f", error, total_error) - IF (rank2 .NE. rank1) write(*,*)"error occured, copied ranks not same" - - ! + IF (rank2 .NE. rank1) write(*,*)"error occured, copied ranks not same" + + ! !get the copied space's number of elements. ! CALL h5sget_simple_extent_npoints_f(space2_id, npoints, error) @@ -155,27 +155,27 @@ IF (npoints .NE. 24) write(*,*)"error occured, number of elements not correct" - ! + ! !get the copied space's class type. ! - CALL h5sget_simple_extent_type_f(space2_id, classtype, error) + CALL h5sget_simple_extent_type_f(space2_id, classtype, error) CALL check("h5sget_simple_extent_type_f", error, total_error) IF (classtype .NE. 1) write(*,*)"class type not H5S_SIMPLE_f" - ! + ! !set the copied space to dim2 size. ! CALL h5sset_extent_simple_f(space2_id, rank2, dims2, maxdims2, error) CALL check("h5sset_extent_simple_f", error, total_error) - ! + ! !get the copied space's dimensions. ! CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error) CALL check("h5sget_simple_extent_dims_f", error, total_error) IF ((dimsout(1) .NE. dims2(1)) .OR. (dimsout(2) .NE. dims2(2)) ) THEN write(*,*)"error occured, copied dims not same" - END IF + END IF ! ! Create the datasets with default properties in two files. @@ -196,7 +196,7 @@ CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, data1_in, data_dims, error) CALL check("h5dwrite_f", error, total_error) - data_dims(1) = 6 + data_dims(1) = 6 data_dims(2) = 6 CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, data2_in, data_dims, error) CALL check("h5dwrite_f", error, total_error) @@ -211,40 +211,40 @@ ! !Compare the data. - ! + ! do i = 1, 4 do j = 1, 6 - IF (data1_out(i,j) .NE. data1_in(i, j)) THEN + IF (data1_out(i,j) .NE. data1_in(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 do ! ! Read the second dataset. ! - data_dims(1) = 6 + data_dims(1) = 6 data_dims(2) = 6 CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, data2_out, data_dims, error) CALL check("h5dread_f", error, total_error) ! !Compare the data. - ! + ! do i = 1, 6 do j = 1, 6 - IF (data2_out(i,j) .NE. data2_in(i, j)) THEN + IF (data2_out(i,j) .NE. data2_in(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 do - ! + ! !Close the datasets. - ! + ! CALL h5dclose_f(dset1_id, error) CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) @@ -257,14 +257,14 @@ CALL check("h5sclose_f", error, total_error) CALL h5sclose_f(space2_id, error) CALL check("h5sclose_f", error, total_error) - ! + ! ! Close 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) diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 index 7e11b61..f7fd8af 100644 --- a/fortran/test/tH5Sselect.f90 +++ b/fortran/test/tH5Sselect.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,9 +11,9 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! -! ! Testing Selection-related Dataspace Interface functionality. ! @@ -22,17 +22,17 @@ ! h5sget_select_npoints_f, h5sselect_elements_f, h5sselect_all_f, ! h5sselect_none_f, h5sselect_valid_f, h5sselect_hyperslab_f, ! h5sget_select_bounds_f, h5sget_select_elem_pointlist_f, -! h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, +! h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, ! h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f ! SUBROUTINE test_select_hyperslab(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=7), PARAMETER :: filename = "tselect" CHARACTER(LEN=80) :: fix_filename @@ -42,60 +42,60 @@ ! CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier - INTEGER(HID_T) :: memspace ! memspace identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier ! - !Memory space dimensions + !Memory space dimensions ! INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) ! - !Dataset dimensions + !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! - !Size of the hyperslab in the file + !Size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/) ! - !hyperslab offset in the file + !hyperslab offset in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/1,2/) ! - !Size of the hyperslab in memory + !Size of the hyperslab in memory ! INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) ! - !hyperslab offset in memory + !hyperslab offset in memory ! INTEGER(HSIZE_T), DIMENSION(3) :: offset_out = (/3,0,0/) ! - !data to write + !data to write ! INTEGER, DIMENSION(5,6) :: data ! - !output buffer + !output buffer ! INTEGER, DIMENSION(7,7,3) :: data_out ! - !dataset space rank + !dataset space rank ! - INTEGER :: dsetrank = 2 + INTEGER :: dsetrank = 2 ! - !memspace rank + !memspace rank ! INTEGER :: memrank = 3 @@ -103,23 +103,23 @@ ! - !general purpose integer + !general purpose integer ! - INTEGER :: i, j + INTEGER :: i, j ! - !flag to check operation success + !flag to check operation success ! - INTEGER :: error + INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims ! - !This writes data to the HDF5 file. + !This writes data to the HDF5 file. ! ! - !data initialization + !data initialization ! do i = 1, 5 do j = 1, 6 @@ -137,12 +137,12 @@ ! !Initialize FORTRAN predifined datatypes ! -! CALL h5init_types_f(error) +! CALL h5init_types_f(error) ! CALL check("h5init_types_f", error, total_error) ! !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" @@ -152,7 +152,7 @@ CALL check("h5fcreate_f", error, total_error) ! - !Create the data space for the dataset. + !Create the data space for the dataset. ! CALL h5screate_simple_f(dsetrank, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) @@ -168,7 +168,7 @@ ! Write the dataset ! data_dims(1) = 5 - data_dims(2) = 6 + data_dims(2) = 6 CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) @@ -191,7 +191,7 @@ CALL check("h5fclose_f", error, total_error) ! - !This reads the hyperslab from the sds.h5 file just + !This reads the hyperslab from the sds.h5 file just !created, into a 2-dimensional plane of the 3-dimensional array. ! @@ -228,7 +228,7 @@ !Select hyperslab in the dataset. ! CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & - offset, count, error) + offset, count, error) CALL check("h5sselect_hyperslab_f", error, total_error) ! !create memory dataspace. @@ -240,16 +240,16 @@ !Select hyperslab in memory. ! CALL h5sselect_hyperslab_f(memspace, H5S_SELECT_SET_F, & - offset_out, count_out, error) + offset_out, count_out, error) CALL check("h5sselect_hyperslab_f", error, total_error) ! - !Read data from hyperslab in the file into the hyperslab in + !Read data from hyperslab in the file into the hyperslab in !memory and display. ! data_dims(1) = 7 - data_dims(2) = 7 - data_dims(3) = 3 + data_dims(2) = 7 + data_dims(3) = 3 CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & memspace, dataspace) CALL check("h5dread_f", error, total_error) @@ -264,7 +264,7 @@ ! 0 0 0 0 0 0 0 ! 0 0 0 0 0 0 0 ! 0 0 0 0 0 0 0 - ! 3 4 5 6 0 0 0 + ! 3 4 5 6 0 0 0 ! 4 5 6 7 0 0 0 ! 5 6 7 8 0 0 0 ! 0 0 0 0 0 0 0 @@ -307,11 +307,11 @@ SUBROUTINE test_select_element(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error ! !the dataset1 is stored in file "copy1.h5" @@ -335,60 +335,60 @@ CHARACTER(LEN=8), PARAMETER :: dsetname2 = "Copy2" ! - !dataset rank + !dataset rank ! INTEGER, PARAMETER :: RANK = 2 ! - !number of points selected + !number of points selected ! INTEGER(SIZE_T), PARAMETER :: NUMP = 2 - INTEGER(HID_T) :: file1_id ! File1 identifier - INTEGER(HID_T) :: file2_id ! File2 identifier - INTEGER(HID_T) :: dset1_id ! Dataset1 identifier - INTEGER(HID_T) :: dset2_id ! Dataset2 identifier - INTEGER(HID_T) :: dataspace1 ! Dataspace identifier - INTEGER(HID_T) :: dataspace2 ! Dataspace identifier - INTEGER(HID_T) :: memspace ! memspace identifier + INTEGER(HID_T) :: file1_id ! File1 identifier + INTEGER(HID_T) :: file2_id ! File2 identifier + INTEGER(HID_T) :: dset1_id ! Dataset1 identifier + INTEGER(HID_T) :: dset2_id ! Dataset2 identifier + INTEGER(HID_T) :: dataspace1 ! Dataspace identifier + INTEGER(HID_T) :: dataspace2 ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier ! - !Memory space dimensions + !Memory space dimensions ! INTEGER(HSIZE_T), DIMENSION(1) :: dimsm = (/2/) ! - !Dataset dimensions + !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/3,4/) ! - !Points positions in the file + !Points positions in the file ! INTEGER(HSIZE_T), DIMENSION(RANK,NUMP) :: coord ! - !data buffers + !data buffers ! INTEGER, DIMENSION(3,4) :: buf1, buf2, bufnew ! - !value to write + !value to write ! INTEGER, DIMENSION(2) :: val = (/53, 59/) ! - !memory rank + !memory rank ! - INTEGER :: memrank = 1 + INTEGER :: memrank = 1 ! - !general purpose integer + !general purpose integer ! - INTEGER :: i, j + INTEGER :: i, j ! - !flag to check operation success + !flag to check operation success ! INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims @@ -396,11 +396,11 @@ ! !Create two files containing identical datasets. Write 0's to one - !and 1's to the other. + !and 1's to the other. ! ! - !data initialization + !data initialization ! do i = 1, 3 do j = 1, 4 @@ -417,12 +417,12 @@ ! !Initialize FORTRAN predifined datatypes ! -! CALL h5init_types_f(error) +! CALL h5init_types_f(error) ! CALL check("h5init_types_f", error, total_error) ! !Create file1, file2 using default properties. - ! + ! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" @@ -440,7 +440,7 @@ CALL check("h5fcreate_f", error, total_error) ! - !Create the data space for the datasets. + !Create the data space for the datasets. ! CALL h5screate_simple_f(RANK, dimsf, dataspace1, error) CALL check("h5screate_simple_f", error, total_error) @@ -498,8 +498,8 @@ CALL check("h5fclose_f", error, total_error) ! - !Open the two files. Select two points in one file, write values to - !those point locations, then do H5Scopy and write the values to the + !Open the two files. Select two points in one file, write values to + !those point locations, then do H5Scopy and write the values to the !other file. Close files. ! @@ -534,12 +534,12 @@ CALL check("h5screate_simple_f", error, total_error) ! - !Set the selected point positions.Because Fortran array index starts + !Set the selected point positions.Because Fortran array index starts ! from 1, so add one to the actual select points in C ! - coord(1,1) = 1 - coord(2,1) = 2 - coord(1,2) = 1 + coord(1,1) = 1 + coord(2,1) = 2 + coord(1,2) = 1 coord(2,2) = 4 ! @@ -560,7 +560,7 @@ ! !Copy the daspace1 into dataspace2 ! - CALL h5scopy_f(dataspace1, dataspace2, error) + CALL h5scopy_f(dataspace1, dataspace2, error) CALL check("h5scopy_f", error, total_error) ! @@ -683,25 +683,25 @@ SUBROUTINE test_basic_select(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error ! !the dataset is stored in file "testselect.h5" ! CHARACTER(LEN=10), PARAMETER :: filename = "testselect" - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename ! - !dataspace rank + !dataspace rank ! INTEGER, PARAMETER :: RANK = 2 ! - !select NUMP_POINTS points from the file + !select NUMP_POINTS points from the file ! INTEGER(SIZE_T), PARAMETER :: NUMPS = 10 @@ -710,86 +710,86 @@ ! CHARACTER(LEN=10), PARAMETER :: dsetname = "testselect" - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dataspace ! Dataspace identifier ! - !Dataset dimensions + !Dataset dimensions ! INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) ! - !Size of the hyperslab in the file + !Size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: count = (/2,2/) ! - !hyperslab offset in the file + !hyperslab offset in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/0,0/) ! - !start block for getting the selected hyperslab + !start block for getting the selected hyperslab ! INTEGER(HSIZE_T) :: startblock = 0 ! - !start point for getting the selected elements + !start point for getting the selected elements ! INTEGER(HSIZE_T) :: startpoint = 0 ! - !Stride of the hyperslab in the file + !Stride of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: stride = (/3,3/) ! - !BLock size of the hyperslab in the file + !BLock size of the hyperslab in the file ! INTEGER(HSIZE_T), DIMENSION(2) :: block = (/2,2/) ! - !array to give selected points' coordinations + !array to give selected points' coordinations ! INTEGER(HSIZE_T), DIMENSION(RANK, NUMPS) :: coord ! - !Number of hyperslabs selected in the current dataspace + !Number of hyperslabs selected in the current dataspace ! INTEGER(HSSIZE_T) :: num_blocks ! !allocatable array for putting a list of hyperslabs - !selected in the current file dataspace + !selected in the current file dataspace ! INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: blocklist ! - !Number of points selected in the current dataspace + !Number of points selected in the current dataspace ! INTEGER(HSSIZE_T) :: num_points INTEGER(HSIZE_T) :: num1_points ! !allocatable array for putting a list of points - !selected in the current file dataspace + !selected in the current file dataspace ! INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: pointlist ! - !start and end bounds in the current dataspace selection + !start and end bounds in the current dataspace selection ! INTEGER(HSIZE_T), DIMENSION(RANK) :: startout, endout ! - !data to write + !data to write ! INTEGER, DIMENSION(5,6) :: data ! - !flag to check operation success + !flag to check operation success ! INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims @@ -797,7 +797,7 @@ INTEGER :: i ! - !initialize the coord array to give the selected points' position + !initialize the coord array to give the selected points' position ! coord(1,1) = 1 coord(2,1) = 1 @@ -822,7 +822,7 @@ ! !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" @@ -832,7 +832,7 @@ CALL check("h5fcreate_f", error, total_error) ! - !Create the data space for the dataset. + !Create the data space for the dataset. ! CALL h5screate_simple_f(RANK, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) @@ -875,7 +875,7 @@ ! CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error) CALL check("h5fopen_f", error, total_error) - + ! !Open the dataset. ! @@ -892,11 +892,11 @@ !Select hyperslab in the dataset. ! CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & - offset, count, error, stride, block) + offset, count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) ! - !get the number of hyperslab blocks in the current dataspac selection + !get the number of hyperslab blocks in the current dataspac selection ! CALL h5sget_select_hyper_nblocks_f(dataspace, num_blocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) @@ -911,16 +911,16 @@ if(error .NE. 0) then STOP endif - + ! - !get the list of hyperslabs selected in the current dataspac selection + !get the list of hyperslabs selected in the current dataspac selection ! CALL h5sget_select_hyper_blocklist_f(dataspace, startblock, & num_blocks, blocklist, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) ! write(*,*) (blocklist(i), i =1, num_blocks*RANK*2) !result of blocklist selected is: - !1, 1, 2, 2, 4, 1, 5, 2, 1, 4, 2, 5, 4, 4, 5, 5 + !1, 1, 2, 2, 4, 1, 5, 2, 1, 4, 2, 5, 4, 4, 5, 5 ! !deallocate the blocklist array @@ -928,7 +928,7 @@ DEALLOCATE(blocklist) ! - !get the selection bounds in the current dataspac selection + !get the selection bounds in the current dataspac selection ! CALL h5sget_select_bounds_f(dataspace, startout, endout, error) CALL check("h5sget_select_bounds_f", error, total_error) @@ -967,7 +967,7 @@ CALL h5sget_select_elem_npoints_f(dataspace, num_points, error) CALL check("h5sget_select_elem_npoints_f", error, total_error) IF (num_points .NE. 10) write(*,*) "error occured with num_points" - !write(*,*) num_points + !write(*,*) num_points ! result of num_points is 10 ! @@ -977,11 +977,11 @@ CALL h5sget_select_elem_pointlist_f(dataspace, startpoint, & num1_points, pointlist, error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) - !write(*,*) (pointlist(i), i =1, num1_points*RANK) + !write(*,*) (pointlist(i), i =1, num1_points*RANK) !result of pintlist is: - !1, 1, 3, 1, 5, 1, 1, 3, 3, 3, 5, 3, 3, + !1, 1, 3, 1, 5, 1, 1, 3, 3, 3, 5, 3, 3, !4, 1, 4, 3, 5, 5, 5 - + ! !deallocate the pointlist array ! @@ -1021,13 +1021,13 @@ !****************************************************************/ SUBROUTINE test_select_point(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER(HID_T) :: xfer_plist - + INTEGER, PARAMETER :: SPACE1_DIM1=3 INTEGER, PARAMETER :: SPACE1_DIM2=15 INTEGER, PARAMETER :: SPACE1_DIM3=13 @@ -1035,11 +1035,11 @@ SUBROUTINE test_select_point(cleanup, total_error) INTEGER, PARAMETER :: SPACE2_DIM2=26 INTEGER, PARAMETER :: SPACE3_DIM1=15 INTEGER, PARAMETER :: SPACE3_DIM2=26 - + INTEGER, PARAMETER :: SPACE1_RANK=3 INTEGER, PARAMETER :: SPACE2_RANK=2 INTEGER, PARAMETER :: SPACE3_RANK=2 - + ! /* Element selection information */ INTEGER, PARAMETER :: POINT1_NPOINTS=10 INTEGER(hid_t) ::fid1 ! /* HDF5 File IDs */ @@ -1048,7 +1048,7 @@ SUBROUTINE test_select_point(cleanup, total_error) INTEGER(hsize_t), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) INTEGER(hsize_t), DIMENSION(1:2) :: dims2 = (/SPACE2_DIM1, SPACE2_DIM2/) INTEGER(hsize_t), DIMENSION(1:2) :: dims3 = (/SPACE3_DIM1, SPACE3_DIM2/) - + INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 !/* Coordinates for point selection */ INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 !/* Coordinates for point selection */ INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 !/* Coordinates for point selection */ @@ -1064,7 +1064,7 @@ SUBROUTINE test_select_point(cleanup, total_error) ! struct pnt_iter pi; /* Custom Pointer iterator struct */ INTEGER :: error !/* Generic return value */ CHARACTER(LEN=9) :: filename = 'h5s_hyper' - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf, rbuf CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) @@ -1090,11 +1090,11 @@ SUBROUTINE test_select_point(cleanup, total_error) !!$ for(i=0, tbuf=wbuf; i<SPACE2_DIM1; i++) !!$ for(j=0; j<SPACE2_DIM2; j++) !!$ *tbuf++=(uint8_t)((i*SPACE2_DIM2)+j); - + !/* Create file */ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid1, error) CALL check("h5fcreate_f", error, total_error) - + !/* Create dataspace for dataset */ CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error) CALL check("h5screate_simple_f", error, total_error) @@ -1151,7 +1151,7 @@ SUBROUTINE test_select_point(cleanup, total_error) CALL h5sselect_elements_f(sid1, H5S_SELECT_APPEND_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error) CALL check("h5sselect_elements_f", error, total_error) ! /* Verify correct elements selected */ - + CALL h5sget_select_elem_pointlist_f(sid1, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1182,7 +1182,7 @@ SUBROUTINE test_select_point(cleanup, total_error) !/* Verify correct elements selected */ - + CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error) CALL check("h5sget_select_elem_pointlist_f", error, total_error) @@ -1349,8 +1349,8 @@ END SUBROUTINE test_select_point !****************************************************************/ SUBROUTINE test_select_combine(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error @@ -1358,7 +1358,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) INTEGER, PARAMETER :: SPACE7_RANK = 2 INTEGER, PARAMETER :: SPACE7_DIM1 = 10 INTEGER, PARAMETER :: SPACE7_DIM2 = 10 - + INTEGER(hid_t) :: base_id ! /* Base dataspace for test */ INTEGER(hid_t) :: all_id ! /* Dataspace for "all" selection */ INTEGER(hid_t) :: none_id ! /* Dataspace for "none" selection */ @@ -1378,7 +1378,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5screate_simple_f", error, total_error) ! /* Copy base dataspace and set selection to "all" */ - CALL h5scopy_f(base_id, all_id, error) + CALL h5scopy_f(base_id, all_id, error) CALL check("h5scopy_f", error, total_error) CALL H5Sselect_all_f(all_id, error) @@ -1389,7 +1389,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error) !/* Copy base dataspace and set selection to "none" */ - CALL h5scopy_f(base_id, none_id, error) + CALL h5scopy_f(base_id, none_id, error) CALL check("h5scopy_f", error, total_error) CALL H5Sselect_none_f(none_id, error) @@ -1398,9 +1398,9 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL H5Sget_select_type_f(none_id, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error) - + !/* Copy "all" selection & space */ - CALL H5Scopy_f(all_id, space1, error) + CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) !/* 'OR' "all" selection with another hyperslab */ @@ -1409,7 +1409,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) icount(1:2) = 1 iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) !/* Verify that it's still "all" selection */ @@ -1422,7 +1422,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) !/* Copy "all" selection & space */ - CALL H5Scopy_f(all_id, space1, error) + CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'AND' "all" selection with another hyperslab */ @@ -1431,7 +1431,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) icount(1:2) = 1 iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) !/* Verify that the new selection is the same at the original block */ @@ -1443,7 +1443,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error) - + !/* Retrieve the block defined */ CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) @@ -1460,7 +1460,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) !/* Copy "all" selection & space */ - CALL H5Scopy_f(all_id, space1, error) + CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'XOR' "all" selection with another hyperslab */ @@ -1470,7 +1470,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is an inversion of the original block */ @@ -1491,7 +1491,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) ! /* Verify that the correct block is defined */ - ! No guarantee is implied as the order in which blocks are listed. + ! No guarantee is implied as the order in which blocks are listed. ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) !!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) !!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 5, total_error) @@ -1512,7 +1512,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) ! /* Copy "all" selection & space */ - CALL H5Scopy_f(all_id, space1, error) + CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'NOTB' "all" selection with another hyperslab */ @@ -1522,7 +1522,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is an inversion of the original block */ @@ -1540,9 +1540,9 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error) CALL check("h5sget_select_hyper_blocklist_f", error, total_error) - ! /* Verify that the correct block is defined */ + ! /* Verify that the correct block is defined */ - ! No guarantee is implied as the order in which blocks are listed. + ! No guarantee is implied as the order in which blocks are listed. ! So this will ONLY work for square domains iblock(1:2) = (/5,5/) !!$ CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error) @@ -1564,7 +1564,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) ! /* Copy "all" selection & space */ - CALL H5Scopy_f(all_id, space1, error) + CALL H5Scopy_f(all_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'NOTA' "all" selection with another hyperslab */ @@ -1574,7 +1574,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) !/* Verify that the new selection is the "none" selection */ @@ -1587,7 +1587,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) ! /* Copy "none" selection & space */ - CALL H5Scopy_f(none_id, space1, error) + CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'OR' "none" selection with another hyperslab */ @@ -1597,14 +1597,14 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_OR_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is the same as the original hyperslab */ CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - + ! /* Verify that there is only one block */ CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) @@ -1627,7 +1627,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) ! /* Copy "none" selection & space */ - CALL H5Scopy_f(none_id, space1, error) + CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'AND' "none" selection with another hyperslab */ @@ -1637,7 +1637,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_AND_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is the "none" selection */ @@ -1650,7 +1650,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) ! /* Copy "none" selection & space */ - CALL H5Scopy_f(none_id, space1, error) + CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'XOR' "none" selection with another hyperslab */ @@ -1660,14 +1660,14 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_XOR_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is the same as the original hyperslab */ CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - + ! /* Verify that there is only one block */ CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) @@ -1683,13 +1683,13 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - + ! /* Close temporary dataspace */ CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) ! /* Copy "none" selection & space */ - CALL H5Scopy_f(none_id, space1, error) + CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'NOTB' "none" selection with another hyperslab */ @@ -1699,7 +1699,7 @@ SUBROUTINE test_select_combine(cleanup, total_error) iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTB_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is the "none" selection */ @@ -1712,23 +1712,23 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL check("h5sclose_f", error, total_error) ! /* Copy "none" selection & space */ - CALL H5Scopy_f(none_id, space1, error) + CALL H5Scopy_f(none_id, space1, error) CALL check("h5scopy_f", error, total_error) ! /* 'NOTA' "none" selection with another hyperslab */ start(1:2) = 0 stride(1:2) = 1 icount(1:2) = 1 - iblock(1:2) = (/5,4/) !5 + iblock(1:2) = (/5,4/) !5 CALL h5sselect_hyperslab_f(space1, H5S_SELECT_NOTA_F, start, & - icount, error, stride, iblock) + icount, error, stride, iblock) CALL check("h5sselect_hyperslab_f", error, total_error) ! /* Verify that the new selection is the same as the original hyperslab */ CALL H5Sget_select_type_f(space1, sel_type, error) CALL check("H5Sget_select_type_f", error, total_error) CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error) - + ! /* Verify that there is ONLY one BLOCK */ CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error) CALL check("h5sget_select_hyper_nblocks_f", error, total_error) @@ -1747,13 +1747,13 @@ SUBROUTINE test_select_combine(cleanup, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error) CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error) - + ! /* Close temporary dataspace */ CALL h5sclose_f(space1, error) CALL check("h5sclose_f", error, total_error) ! /* Close dataspaces */ - + CALL h5sclose_f(base_id, error) CALL check("h5sclose_f", error, total_error) CALL h5sclose_f(all_id, error) @@ -1771,8 +1771,8 @@ END SUBROUTINE test_select_combine !****************************************************************/ SUBROUTINE test_select_bounds(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error @@ -1781,7 +1781,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) INTEGER, PARAMETER :: SPACE11_DIM1=100 INTEGER, PARAMETER :: SPACE11_DIM2=50 INTEGER, PARAMETER :: SPACE11_NPOINTS=4 - + INTEGER(hid_t) :: sid ! /* Dataspace ID */ INTEGER(hsize_t), DIMENSION(1:SPACE11_RANK) :: dims = (/SPACE11_DIM1, SPACE11_DIM2/) !Dataspace dimensions INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord !/* Coordinates for point selection @@ -1792,7 +1792,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset !/* Offset amount for selection */ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds !/* The low bounds for the selection */ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds !/* The high bounds for the selection */ - + INTEGER :: error !/* Create dataspace */ @@ -1836,7 +1836,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) !/* Set point selection */ - + coord(1,1)= 3; coord(2,1)= 3; coord(1,2)= 3; coord(2,2)= 46; coord(1,3)= 96; coord(2,3)= 3; @@ -1863,7 +1863,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) ! /* Get bounds for hyperslab selection with negative offset */ CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error) CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error) - + ! /* Set valid offset for selection */ offset(1:2) = (/2,-2/) CALL H5Soffset_simple_f(sid, offset, error) @@ -1888,9 +1888,9 @@ SUBROUTINE test_select_bounds(cleanup, total_error) stride(1:2) = 10 count(1:2) = 4 block(1:2) = 5 - + CALL h5sselect_hyperslab_f(sid, H5S_SELECT_SET_F, start, & - count, error, stride, block) + count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) !/* Get bounds for hyperslab selection */ @@ -1929,7 +1929,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) offset(1:2) = 0 CALL H5Soffset_simple_f(sid, offset, error) CALL check("H5Soffset_simple_f", error, total_error) - + ! /* Make "irregular" hyperslab selection */ start(1:2) = 20 stride(1:2) = 20 @@ -1937,7 +1937,7 @@ SUBROUTINE test_select_bounds(cleanup, total_error) block(1:2) = 10 CALL h5sselect_hyperslab_f(sid, H5S_SELECT_OR_F, start, & - count, error, stride, block) + count, error, stride, block) CALL check("h5sselect_hyperslab_f", error, total_error) !/* Get bounds for hyperslab selection */ diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 5a17a21..d298694 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,7 +11,7 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE compoundtest(cleanup, total_error) ! @@ -30,20 +30,20 @@ ! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=8), PARAMETER :: filename = "compound" ! File name CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=8), PARAMETER :: dsetname = "Compound" ! Dataset name INTEGER, PARAMETER :: dimsize = 6 ! Size of the dataset - INTEGER, PARAMETER :: COMP_NUM_MEMBERS = 4 ! Number of members in the compound datatype + INTEGER, PARAMETER :: COMP_NUM_MEMBERS = 4 ! Number of members in the compound datatype - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + 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 ! Compound datatype identifier INTEGER(HID_T) :: dtarray_id ! Compound datatype identifier @@ -52,8 +52,8 @@ INTEGER(HID_T) :: dt2_id ! Memory datatype identifier (for integer field) INTEGER(HID_T) :: dt3_id ! Memory datatype identifier (for double precision field) INTEGER(HID_T) :: dt4_id ! Memory datatype identifier (for real field) - INTEGER(HID_T) :: dt5_id ! Memory datatype identifier - INTEGER(HID_T) :: membtype_id ! Datatype identifier + INTEGER(HID_T) :: dt5_id ! Memory datatype identifier + INTEGER(HID_T) :: membtype_id ! Datatype identifier INTEGER(HID_T) :: plist_id ! Dataset trasfer property @@ -62,7 +62,7 @@ INTEGER :: error ! Error flag INTEGER(SIZE_T) :: type_size ! Size of the datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype + INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype @@ -77,10 +77,10 @@ REAL, DIMENSION(dimsize) :: real_member REAL, DIMENSION(dimsize) :: real_member_out INTEGER :: i - INTEGER :: class ! Datatype class + INTEGER :: class ! Datatype class INTEGER :: num_members ! Number of members in the compound datatype - CHARACTER(LEN=256) :: member_name - INTEGER :: len ! Lenght of the name of the compound datatype member + CHARACTER(LEN=256) :: member_name + INTEGER :: len ! Lenght of the name of the compound datatype member INTEGER :: member_index ! index of the field INTEGER(HSIZE_T), DIMENSION(3) :: array_dims=(/2,3,4/) INTEGER :: array_dims_range = 3 @@ -88,7 +88,7 @@ INTEGER(SIZE_T) :: sizechar INTEGER(HSIZE_T), DIMENSION(1) :: data_dims LOGICAL :: flag = .TRUE. - + CHARACTER(LEN=1024) :: cmpd_buf INTEGER(SIZE_T) :: cmpd_buf_size=0 INTEGER(HID_T) :: decoded_sid1 @@ -101,8 +101,8 @@ do i = 1, dimsize char_member(i)(1:1) = char(65+i) char_member(i)(2:2) = char(65+i) - char_member_out(i)(1:1) = char(65) - char_member_out(i)(2:2) = char(65) + char_member_out(i)(1:1) = char(65) + char_member_out(i)(2:2) = char(65) int_member(i) = i int_member_out(i) = 0 double_member(i) = 2.* i @@ -121,7 +121,7 @@ CALL check("h5pset_preserve_f", error, total_error) ! ! 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" @@ -130,7 +130,7 @@ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) @@ -198,19 +198,19 @@ !!$ ! /* Try decoding bogus buffer */ !!$ !!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) -!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error) -!!$ +!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error) +!!$ !!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) !!$ CALL check("H5Tencode_f", error, total_error) !!$ !!$ ! /* Decode from the compound buffer and return an object handle */ !!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) -!!$ CALL check("H5Tdecode_f", error, total_error) +!!$ CALL check("H5Tdecode_f", error, total_error) !!$ !!$ ! /* Verify that the datatype was copied exactly */ -!!$ +!!$ !!$ CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) -!!$ CALL check("H5Tequal_f", error, total_error) +!!$ CALL check("H5Tequal_f", error, total_error) !!$ CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) ! @@ -220,8 +220,8 @@ dset_id, error) CALL check("h5dcreate_f", error, total_error) ! - ! Create memory types. We have to create a compound datatype - ! for each member we want to write. + ! Create memory types. We have to create a compound datatype + ! for each member we want to write. ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dt1_id, error) CALL check("h5tcreate_f", error, total_error) @@ -258,9 +258,9 @@ CALL h5dwrite_f(dset_id, dt2_id, int_member, data_dims, error, xfer_prp = plist_id) 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) @@ -284,7 +284,7 @@ CALL check("h5tclose_f", error, total_error) ! - ! Create and store compound datatype with the character and + ! Create and store compound datatype with the character and ! array members. ! type_size = type_sizec + elements*type_sizer ! Size of compound datatype @@ -304,13 +304,13 @@ CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dtarray_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) - + ! ! Open the file. ! @@ -324,7 +324,7 @@ ! ! Get datatype of the open dataset. ! Check it class, number of members, and member's names. - ! + ! CALL h5dget_type_f(dset_id, dtype_id, error) CALL check("h5dget_type_f", error, total_error) CALL h5tget_class_f(dtype_id, class, error) @@ -361,7 +361,7 @@ if(offset_out .ne. 0) then write(*,*) "Offset of the char member is incorrect" total_error = total_error + 1 - endif + endif CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) CALL check("h5tget_member_type_f", error, total_error) CALL h5tequal_f(membtype_id, dt5_id, flag, error) @@ -369,7 +369,7 @@ if(.not. flag) then write(*,*) "Wrong member type returned for character member" total_error = total_error + 1 - endif + endif CALL h5tget_member_class_f(dtype_id, i-1, class, error) CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_STRING_F) then @@ -380,7 +380,7 @@ if(offset_out .ne. type_sizec) then write(*,*) "Offset of the integer member is incorrect" total_error = total_error + 1 - endif + endif CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) CALL check("h5tget_member_type_f", error, total_error) CALL h5tequal_f(membtype_id, H5T_NATIVE_INTEGER, flag, error) @@ -388,7 +388,7 @@ if(.not. flag) then write(*,*) "Wrong member type returned for integer memebr" total_error = total_error + 1 - endif + endif CALL h5tget_member_class_f(dtype_id, i-1, class, error) CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_INTEGER_F) then @@ -399,7 +399,7 @@ if(offset_out .ne. (type_sizec+type_sizei)) then write(*,*) "Offset of the double precision member is incorrect" total_error = total_error + 1 - endif + endif CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) CALL check("h5tget_member_type_f", error, total_error) CALL h5tequal_f(membtype_id, H5T_NATIVE_DOUBLE, flag, error) @@ -407,7 +407,7 @@ if(.not. flag) then write(*,*) "Wrong member type returned for double precision memebr" total_error = total_error + 1 - endif + endif CALL h5tget_member_class_f(dtype_id, i-1, class, error) CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_FLOAT_F) then @@ -418,7 +418,7 @@ if(offset_out .ne. (type_sizec+type_sizei+type_sized)) then write(*,*) "Offset of the real member is incorrect" total_error = total_error + 1 - endif + endif CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) CALL check("h5tget_member_type_f", error, total_error) CALL h5tequal_f(membtype_id, H5T_NATIVE_REAL, flag, error) @@ -426,7 +426,7 @@ if(.not. flag) then write(*,*) "Wrong member type returned for real memebr" total_error = total_error + 1 - endif + endif CALL h5tget_member_class_f(dtype_id, i-1, class, error) CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_FLOAT_F) then @@ -436,7 +436,7 @@ CASE DEFAULT write(*,*) "Wrong member's name" total_error = total_error + 1 - + END SELECT CHECK_NAME enddo @@ -445,7 +445,7 @@ ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt2_id, error) CALL check("h5tcopy_f", error, total_error) - sizechar = 2 + sizechar = 2 CALL h5tset_size_f(dt2_id, sizechar, error) CALL check("h5tset_size_f", error, total_error) CALL h5tget_size_f(dt2_id, type_size, error) @@ -533,19 +533,19 @@ ! /* Try decoding bogus buffer */ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) - CALL VERIFY("H5Tdecode_f", error, -1, total_error) - + CALL VERIFY("H5Tdecode_f", error, -1, total_error) + CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) CALL check("H5Tencode_f", error, total_error) ! /* Decode from the compound buffer and return an object handle */ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) - CALL check("H5Tdecode_f", error, total_error) + CALL check("H5Tdecode_f", error, total_error) ! /* Verify that the datatype was copied exactly */ - + CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) - CALL check("H5Tequal_f", error, total_error) + CALL check("H5Tequal_f", error, total_error) CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) ! ! Close all open objects. @@ -572,35 +572,35 @@ - + SUBROUTINE basic_data_type_test(cleanup, total_error) -! This subroutine tests following functionalities: +! This subroutine tests following functionalities: ! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f ! H5tset_offset_f, H5tget_pad_f, H5tset_pad_f, H5tget_sign_f, ! H5tset_sign_f, H5tget_ebias_f,H5tset_ebias_f, H5tget_norm_f, ! H5tset_norm_f, H5tget_inpad_f, H5tset_inpad_f, H5tget_cset_f, ! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f - USE HDF5 ! This module contains all necessary modules - + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error - INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id + INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id ! datatype identifiers INTEGER(SIZE_T) :: precision ! Datatype precision INTEGER(SIZE_T) :: setprecision ! Datatype precision INTEGER(SIZE_T) :: offset ! Datatype offset INTEGER(SIZE_T) :: setoffset ! Datatype offset - INTEGER :: lsbpad !padding type of the least significant bit - INTEGER :: msbpad !padding type of the most significant bit - INTEGER :: sign !sign type for an integer type - INTEGER(SIZE_T) :: ebias1 !Datatype exponent bias of a floating-point type + INTEGER :: lsbpad !padding type of the least significant bit + INTEGER :: msbpad !padding type of the most significant bit + INTEGER :: sign !sign type for an integer type + INTEGER(SIZE_T) :: ebias1 !Datatype exponent bias of a floating-point type INTEGER(SIZE_T) :: ebias2 !Datatype exponent bias of a floating-point type - INTEGER(SIZE_T) :: setebias - INTEGER :: norm !mantissa normalization of a floating-point datatype + INTEGER(SIZE_T) :: setebias + INTEGER :: norm !mantissa normalization of a floating-point datatype INTEGER :: inpad !padding type for unused bits in floating-point datatypes. INTEGER :: cset !character set type of a string datatype INTEGER :: strpad !string padding method for a string datatype @@ -608,7 +608,7 @@ ! - ! Create a datatype + ! Create a datatype ! CALL h5tcopy_f(H5T_STD_U16BE, dtype1_id, error) CALL check("h5tcopy_f",error,total_error) @@ -624,17 +624,17 @@ write (*,*) "got precision is not correct" total_error = total_error + 1 end if - + CALL h5tcopy_f(H5T_STD_I32LE, dtype2_id, error) CALL check("h5tcopy_f",error,total_error) setprecision = 12 CALL h5tset_precision_f(dtype2_id, setprecision, error) CALL check("h5set_precision_f",error,total_error) - setoffset = 2 + setoffset = 2 CALL h5tset_offset_f(dtype1_id, setoffset, error) CALL check("h5set_offset_f",error,total_error) - setoffset = 10 + setoffset = 10 CALL h5tset_offset_f(dtype2_id, setoffset, error) CALL check("h5set_offset_f",error,total_error) CALL h5tget_offset_f(dtype2_id,offset, error) @@ -643,7 +643,7 @@ write (*,*) "got offset is not correct" total_error = total_error + 1 end if - + CALL h5tset_pad_f(dtype2_id,H5T_PAD_ONE_F, H5T_PAD_ONE_F, error) CALL check("h5set_pad_f",error,total_error) CALL h5tget_pad_f(dtype2_id,lsbpad,msbpad, error) @@ -671,7 +671,7 @@ setebias = 257 CALL h5tset_ebias_f(dtype3_id, setebias, error) CALL check("h5tset_ebias_f",error,total_error) - setebias = 1 + setebias = 1 CALL h5tset_ebias_f(dtype4_id, setebias, error) CALL check("h5tset_ebias_f",error,total_error) CALL h5tget_ebias_f(dtype3_id, ebias1, error) @@ -686,7 +686,7 @@ write (*,*) "got ebias is not correct" total_error = total_error + 1 end if - + !attention: !It seems that I can't use H5T_NORM_IMPLIED_F to set the norm value !because I got error for the get_norm function @@ -744,7 +744,7 @@ end if ! we should not apply h5tset_cset_f to non_character data typemake - + ! CALL h5tset_cset_f(dtype4_id, H5T_CSET_ASCII_F, error) ! CALL check("h5tset_cset_f",error,total_error) ! CALL h5tget_cset_f(dtype4_id, cset, error) @@ -803,22 +803,22 @@ IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=4), PARAMETER :: filename="enum" CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=8), PARAMETER :: dsetname="enumdset" CHARACTER(LEN=4) :: true ="TRUE" CHARACTER(LEN=5) :: false="FALSE" - CHARACTER(LEN=5) :: mem_name + CHARACTER(LEN=5) :: mem_name INTEGER(HID_T) :: file_id INTEGER(HID_T) :: dset_id INTEGER(HID_T) :: dspace_id - INTEGER(HID_T) :: dtype_id, dtype, native_type + INTEGER(HID_T) :: dtype_id, dtype, native_type INTEGER :: error INTEGER :: value INTEGER(HSIZE_T), DIMENSION(1) :: dsize - INTEGER(SIZE_T) :: buf_size + INTEGER(SIZE_T) :: buf_size INTEGER, DIMENSION(2) :: data INTEGER(HSIZE_T), DIMENSION(7) :: dims INTEGER :: order1, order2 @@ -831,7 +831,7 @@ data(2) = 0 ! ! 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" @@ -869,7 +869,7 @@ CALL check("H5Tget_order_f",error, total_error) CALL H5Tget_order_f(H5T_NATIVE_INTEGER, order2, error) CALL check("H5Tget_order_f",error, total_error) - CALL VERIFY("H5Tget_native_type_f",order1, order2, total_error) + CALL VERIFY("H5Tget_native_type_f",order1, order2, total_error) ! this test depends on whether -i8 was specified @@ -877,12 +877,12 @@ !!$ CALL check("H5Tget_size_f",error, total_error) !!$ CALL H5Tget_size_f(H5T_STD_I32BE, type_size2, error) !!$ CALL check("H5Tget_size_f",error, total_error) -!!$ CALL VERIFY("H5Tget_native_type_f", INT(type_size1), INT(type_size2), total_error) +!!$ CALL VERIFY("H5Tget_native_type_f", INT(type_size1), INT(type_size2), total_error) CALL H5Tget_class_f(native_type, class, error) CALL check("H5Tget_class_f",error, total_error) - CALL VERIFY("H5Tget_native_type_f", INT(class), INT(H5T_ENUM_F), total_error) - + CALL VERIFY("H5Tget_native_type_f", INT(class), INT(H5T_ENUM_F), total_error) + CALL h5dclose_f(dset_id,error) CALL check("h5dclose_f", error, total_error) CALL h5sclose_f(dspace_id,error) @@ -937,17 +937,17 @@ ! *------------------------------------------------------------------------- ! */ -SUBROUTINE test_derived_flt(cleanup, total_error) +SUBROUTINE test_derived_flt(cleanup, total_error) + + USE HDF5 ! This module contains all necessary modules - USE HDF5 ! This module contains all necessary modules - IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1 INTEGER(hid_t) :: dxpl_id=-1 INTEGER(size_t) :: spos, epos, esize, mpos, msize, size - + CHARACTER(LEN=15), PARAMETER :: filename="h5t_derived_flt" CHARACTER(LEN=80) :: fix_filename @@ -965,7 +965,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL h5fcreate_f(fix_filename,H5F_ACC_TRUNC_F,file,error) CALL check("h5fcreate_f", error, total_error) - + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, error) CALL check("h5pcreate_f", error, total_error) @@ -1031,7 +1031,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL H5Tget_precision_f(tid1, precision1, error) CALL check("H5Tget_precision_f", error, total_error) - CALL VERIFY("H5Tget_precision_f", INT(precision1), 42, total_error) + CALL VERIFY("H5Tget_precision_f", INT(precision1), 42, total_error) CALL H5Tget_offset_f(tid1, offset1, error) CALL check("H5Tget_offset_f", error, total_error) @@ -1092,7 +1092,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error) CALL H5Tget_precision_f(tid2, precision2, error) CALL check("H5Tget_precision_f", error, total_error) - CALL VERIFY("H5Tget_precision_f", INT(precision2), 24, total_error) + CALL VERIFY("H5Tget_precision_f", INT(precision2), 24, total_error) CALL H5Tget_offset_f(tid2, offset2, error) CALL check("H5Tget_offset_f", error, total_error) diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90 index 13f2af1..3afd025 100644 --- a/fortran/test/tH5VL.f90 +++ b/fortran/test/tH5VL.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,34 +11,34 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! Testing Variable_length datatypes ! ! ! SUBROUTINE vl_test_integer(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=7), PARAMETER :: filename = "VLtypes" ! File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=5), PARAMETER :: dsetname = "VLint" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: vltype_id ! Datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/6/) ! Dataset dimensions - INTEGER(SIZE_T), DIMENSION(6) :: len ! Elements lengths - INTEGER(SIZE_T), DIMENSION(6) :: len_out + INTEGER(SIZE_T), DIMENSION(6) :: len ! Elements lengths + INTEGER(SIZE_T), DIMENSION(6) :: len_out INTEGER :: rank = 1 ! Dataset rank INTEGER, DIMENSION(5,6) :: vl_int_data ! Data buffers @@ -52,14 +52,14 @@ ! ! Initialize the vl_int_data array. ! - do i = 1, 6 - do j = 1, 5 + do i = 1, 6 + do j = 1, 5 vl_int_data(j,i) = -100 end do end do - do i = 2, 6 - do j = 1, i-1 + do i = 2, 6 + do j = 1, i-1 vl_int_data(j,i) = i-1 end do end do @@ -71,7 +71,7 @@ ! ! 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" @@ -81,7 +81,7 @@ CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) @@ -105,13 +105,13 @@ CALL check("h5dwrite_int_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) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -124,11 +124,11 @@ CALL check("h5fopen_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) - + CALL h5dvlen_get_max_len_f(dset_id, vltype_id, dspace_id, max_len, error) CALL check("h5dvlen_get_max_len_f", error, total_error) if(max_len .ne. data_dims(1)) then @@ -168,37 +168,37 @@ 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) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE vl_test_integer SUBROUTINE vl_test_real(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=8), PARAMETER :: filename = "VLtypesR" ! File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=6), PARAMETER :: dsetname = "VLreal" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: vltype_id ! Datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/6/) ! Dataset dimensions - INTEGER(SIZE_T), DIMENSION(6) :: len ! Elements lengths - INTEGER(SIZE_T), DIMENSION(6) :: len_out + INTEGER(SIZE_T), DIMENSION(6) :: len ! Elements lengths + INTEGER(SIZE_T), DIMENSION(6) :: len_out INTEGER :: rank = 1 ! Dataset rank REAL, DIMENSION(5,6) :: vl_real_data ! Data buffers @@ -214,14 +214,14 @@ ! ! Initialize the vl_int_data array. ! - do i = 1, 6 - do j = 1, 5 + do i = 1, 6 + do j = 1, 5 vl_real_data(j,i) = -100. end do end do - do i = 2, 6 - do j = 1, i-1 + do i = 2, 6 + do j = 1, i-1 vl_real_data(j,i) = i-1 end do end do @@ -233,7 +233,7 @@ ! ! 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" @@ -243,7 +243,7 @@ CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) @@ -276,13 +276,13 @@ CALL check("h5dwrite_vl_real_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) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -295,11 +295,11 @@ CALL check("h5fopen_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) - + CALL h5dvlen_get_max_len_f(dset_id, vltype_id, dspace_id, max_len, error) CALL check("h5dvlen_get_max_len_f", error, total_error) if(max_len .ne. data_dims(1)) then @@ -339,36 +339,36 @@ 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) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE vl_test_real SUBROUTINE vl_test_string(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error CHARACTER(LEN=8), PARAMETER :: filename = "VLtypesS" ! File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=9), PARAMETER :: dsetname = "VLstrings" ! Dataset name - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/4/) ! Dataset dimensions - INTEGER(SIZE_T), DIMENSION(4) :: str_len ! Elements lengths - INTEGER(SIZE_T), DIMENSION(4) :: str_len_out + INTEGER(SIZE_T), DIMENSION(4) :: str_len ! Elements lengths + INTEGER(SIZE_T), DIMENSION(4) :: str_len_out INTEGER :: rank = 1 ! Dataset rank CHARACTER(LEN=10), DIMENSION(4) :: string_data ! Array of strings @@ -388,14 +388,14 @@ string_data(2) = 'a fortran ' str_len(2) = 10 string_data(3) = 'strings ' - str_len(3) = 8 + str_len(3) = 8 string_data(4) = 'test. ' - str_len(4) = 5 + str_len(4) = 5 ! ! 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" @@ -405,7 +405,7 @@ CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) @@ -437,13 +437,13 @@ CALL check("h5dwrite_string_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) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -456,7 +456,7 @@ CALL check("h5fopen_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) @@ -471,13 +471,13 @@ total_error=total_error + 1 write(*,*) 'Returned string length is incorrect' goto 100 - endif + endif if(string_data(1)(1:str_len(i)) .ne. string_data_out(1)(1:str_len(i))) then write(*,*) ' Returned string is wrong' total_error = total_error + 1 endif -100 continue - +100 continue + ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) @@ -488,14 +488,14 @@ 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) if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) - + RETURN END SUBROUTINE vl_test_string diff --git a/fortran/test/tH5Z.f90 b/fortran/test/tH5Z.f90 index ea567a2..6262528 100644 --- a/fortran/test/tH5Z.f90 +++ b/fortran/test/tH5Z.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,17 +11,17 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! SUBROUTINE filters_test(cleanup, total_error) ! This subroutine tests following functionalities: h5zfilter_avail_f, h5zunregister_f - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(OUT) :: total_error LOGICAL :: status INTEGER(HID_T) :: crtpr_id, xfer_id INTEGER :: nfilters @@ -44,11 +44,11 @@ CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) CALL check("h5pset_chunk_f",error, total_error) CALL h5pset_deflate_f(crtpr_id, dlevel, error) - CALL check("h5pset_deflate_f", error, total_error) + CALL check("h5pset_deflate_f", error, total_error) CALL h5pclose_f(crtpr_id,error) CALL check("h5pclose_f", error, total_error) endif - + ! ! Shuffle filter ! @@ -60,11 +60,11 @@ CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) CALL check("h5pset_chunk_f",error, total_error) CALL h5pset_shuffle_f(crtpr_id, error) - CALL check("h5pset_shuffle_f", error, total_error) + CALL check("h5pset_shuffle_f", error, total_error) CALL h5pclose_f(crtpr_id,error) CALL check("h5pclose_f", error, total_error) endif - + ! ! Checksum filter ! @@ -76,7 +76,7 @@ CALL h5pset_chunk_f(crtpr_id, RANK, ch_dims, error) CALL check("h5pset_chunk_f",error, total_error) CALL h5pset_fletcher32_f(crtpr_id, error) - CALL check("h5pset_fletcher32_f", error, total_error) + CALL check("h5pset_fletcher32_f", error, total_error) CALL h5pclose_f(crtpr_id,error) CALL check("h5pclose_f", error, total_error) CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_id, error) @@ -106,11 +106,11 @@ CALL h5pcreate_f(H5P_DATASET_CREATE_F, crtpr_id, error) CALL check("h5pcreate_f", error, total_error) CALL h5pset_fletcher32_f(crtpr_id, error) - CALL check("h5pset_fletcher32_f", error, total_error) + CALL check("h5pset_fletcher32_f", error, total_error) CALL h5pset_shuffle_f(crtpr_id, error) - CALL check("h5pset_shuffle_f", error, total_error) + CALL check("h5pset_shuffle_f", error, total_error) CALL h5pget_nfilters_f(crtpr_id, nfilters, error) - CALL check("h5pget_nfilters_f", error, total_error) + CALL check("h5pget_nfilters_f", error, total_error) ! Verify the correct number of filters if (nfilters .ne. 2) then @@ -120,11 +120,11 @@ ! Delete a single filter CALL h5premove_filter_f(crtpr_id, H5Z_FILTER_SHUFFLE_F, error) - CALL check("h5pset_shuffle_f", error, total_error) + CALL check("h5pset_shuffle_f", error, total_error) ! Verify the correct number of filters now CALL h5pget_nfilters_f(crtpr_id, nfilters, error) - CALL check("h5pget_nfilters_f", error, total_error) + CALL check("h5pget_nfilters_f", error, total_error) if (nfilters .ne. 1) then write(*,*) "number of filters is wrong" total_error = total_error + 1 @@ -132,11 +132,11 @@ ! Delete all filters CALL h5premove_filter_f(crtpr_id, H5Z_FILTER_ALL_F, error) - CALL check("h5premove_filter_f", error, total_error) + CALL check("h5premove_filter_f", error, total_error) ! Verify the correct number of filters now CALL h5pget_nfilters_f(crtpr_id, nfilters, error) - CALL check("h5pget_nfilters_f", error, total_error) + CALL check("h5pget_nfilters_f", error, total_error) if (nfilters .ne. 0) then write(*,*) "number of filters is wrong" total_error = total_error + 1 @@ -150,24 +150,24 @@ END SUBROUTINE filters_test SUBROUTINE szip_test(szip_flag, cleanup, total_error) - USE HDF5 ! This module contains all necessary modules + USE HDF5 ! This module contains all necessary modules IMPLICIT NONE LOGICAL, INTENT(OUT) :: szip_flag LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=4), PARAMETER :: filename = "szip" ! File name - CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=80) :: fix_filename CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name INTEGER, PARAMETER :: N = 1024 INTEGER, PARAMETER :: NN = 64 INTEGER, PARAMETER :: M = 512 INTEGER, PARAMETER :: MM = 32 - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: dset_id ! Dataset identifier + 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 @@ -183,9 +183,9 @@ INTEGER :: i, j !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims INTEGER(HID_T) :: crp_list - INTEGER :: options_mask, pix_per_block + INTEGER :: options_mask, pix_per_block LOGICAL :: flag - CHARACTER(LEN=4) filter_name + CHARACTER(LEN=4) filter_name INTEGER :: filter_flag = -1 INTEGER(SIZE_T) :: cd_nelemnts = 4 @@ -213,7 +213,7 @@ CALL h5zget_filter_info_f(H5Z_FILTER_SZIP_F, config_flag, error) CALL check("h5zget_filter_info_f", error, total_error) ! Quit if failed - if (error .ne. 0) return + if (error .ne. 0) return ! ! Make sure h5zget_filter_info_f returns the right flag ! @@ -225,10 +225,10 @@ CALL check("h5zget_filter_info_f config_flag", error, total_error) endif endif - endif + endif ! Continue only when encoder is available - if ( IAND(config_flag, H5Z_FILTER_ENCODE_ENABLED_F) .EQ. 0 ) return + if ( IAND(config_flag, H5Z_FILTER_ENCODE_ENABLED_F) .EQ. 0 ) return options_mask = H5_SZIP_NN_OM_F pix_per_block = 32 @@ -244,7 +244,7 @@ ! ! 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" @@ -254,12 +254,12 @@ CALL check("h5fcreate_f", error, total_error) - ! + ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) CALL check("h5screate_simple_f", error, total_error) - + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) CALL check("h5pcreat_f",error,total_error) @@ -277,11 +277,11 @@ total_error = -1 return endif - + CALL h5pget_filter_by_id_f(crp_list, H5Z_FILTER_SZIP_F, filter_flag, & - + cd_nelemnts, cd_values,& - + filter_name_len, filter_name, error) CALL check("h5pget_filter_by_id_f",error,total_error) ! @@ -300,9 +300,9 @@ 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) @@ -312,7 +312,7 @@ CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f", error, total_error) - ! + ! ! Close the file. ! CALL h5pclose_f(crp_list, error) @@ -326,20 +326,20 @@ CALL check("h5fopen_f", error, total_error) ! - ! Open the existing dataset. + ! Open the existing dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) CALL check("h5dopen_f", error, total_error) CALL check("h5pget_filter_by_id_f",error,total_error) ! - ! Get the dataset type. + ! 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. + ! Get the data space. ! CALL h5dget_space_f(dset_id, dspace_id, error) CALL check("h5dget_space_f", error, total_error) @@ -352,10 +352,10 @@ ! !Compare the data. - ! + ! do i = 1, N do j = 1, M - IF (data_out(i,j) .NE. dset_data(i, j)) THEN + 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 written" num_errors = num_errors + 1 @@ -364,15 +364,15 @@ goto 100 END IF END IF - end do + end do end do 100 IF (num_errors .GT. 0) THEN total_error=total_error + 1 END IF - ! + ! ! End access to the dataset and release resources used by it. - ! + ! CALL h5dclose_f(dset_id, error) CALL check("h5dclose_f", error, total_error) @@ -387,7 +387,7 @@ ! CALL h5tclose_f(dtype_id, error) CALL check("h5tclose_f", error, total_error) - ! + ! ! Close the file. ! CALL h5fclose_f(file_id, error) @@ -395,6 +395,6 @@ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) CALL check("h5_cleanup_f", error, total_error) endif ! SZIP available - + RETURN END SUBROUTINE szip_test diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90 index b4956ea..51c9410 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -1,4 +1,4 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by The HDF Group. * ! Copyright by the Board of Trustees of the University of Illinois. * ! All rights reserved. * @@ -11,10 +11,10 @@ ! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! ! ! -! ! This file contains subroutines which are used in ! all the hdf5 fortran tests ! @@ -22,7 +22,7 @@ !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: write_test_status +!DEC$attributes dllexport :: write_test_status !DEC$endif SUBROUTINE write_test_status( test_result, test_title, total_error) @@ -31,7 +31,7 @@ IMPLICIT NONE INTEGER, INTENT(IN) :: test_result ! negative, --skip -- - ! 0 , passed + ! 0 , passed ! positive, failed CHARACTER(LEN=*), INTENT(IN) :: test_title ! Short description of test @@ -51,9 +51,9 @@ ELSE IF (test_result == -1) THEN error_string = skip ENDIF - + WRITE(*, fmt = '(A, T72, A)') test_title, error_string - + IF(test_result.GT.0) total_error = total_error + test_result END SUBROUTINE write_test_status @@ -119,19 +119,19 @@ END SUBROUTINE verifyString !---------------------------------------------------------------------- -! Name: h5_fixname_f +! Name: h5_fixname_f ! ! Purpose: Create a file name from the a file base name. ! It is a fortran counterpart for the h5_fixname in ../../test/h5test.c ! -! Inputs: -! base_name - base name of the file -! fapl - file access property list -! Outputs: +! Inputs: +! base_name - base name of the file +! fapl - file access property list +! Outputs: ! full_name - full file name -! hdferr: - error code +! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! Programmer: Elena Pourmal ! September 13, 2002 @@ -144,13 +144,13 @@ SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5_fixname_f !DEC$endif - USE H5GLOBAL + USE H5GLOBAL IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name - INTEGER, INTENT(OUT) :: hdferr ! Error code + CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name + CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name + INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string ! INTEGER(HID_T) :: fapl_default @@ -162,8 +162,8 @@ SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name - !DEC$ATTRIBUTES reference :: full_name + !DEC$ATTRIBUTES reference :: base_name + !DEC$ATTRIBUTES reference :: full_name CHARACTER(LEN=*), INTENT(IN) :: base_name INTEGER(SIZE_T) :: base_namelen INTEGER(HID_T), INTENT(IN) :: fapl @@ -171,27 +171,27 @@ SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) INTEGER(SIZE_T) :: full_namelen END FUNCTION h5_fixname_c END INTERFACE - + base_namelen = LEN(base_name) full_namelen = LEN(full_name) hdferr = h5_fixname_c(base_name, base_namelen, fapl, & - full_name, full_namelen) - + full_name, full_namelen) + END SUBROUTINE h5_fixname_f - + !---------------------------------------------------------------------- -! Name: h5_cleanup_f +! Name: h5_cleanup_f ! ! Purpose: Cleanups tests files ! It is a fortran counterpart for the h5_cleanup in ../../test/h5test.c ! -! Inputs: -! base_name - base name of the file -! fapl - file access property list -! Outputs: -! hdferr: - error code +! Inputs: +! base_name - base name of the file +! fapl - file access property list +! Outputs: +! hdferr: - error code ! Success: 0 -! Failure: -1 +! Failure: -1 ! ! Programmer: Elena Pourmal ! September 19, 2002 @@ -204,34 +204,34 @@ SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr) !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5_cleanup_f !DEC$endif - USE H5GLOBAL + USE H5GLOBAL IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - INTEGER, INTENT(OUT) :: hdferr ! Error code + CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name + INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string - + INTERFACE INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl) USE H5GLOBAL !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name + !DEC$ATTRIBUTES reference :: base_name CHARACTER(LEN=*), INTENT(IN) :: base_name INTEGER(SIZE_T) :: base_namelen INTEGER(HID_T), INTENT(IN) :: fapl END FUNCTION h5_cleanup_c END INTERFACE - + base_namelen = LEN(base_name) hdferr = h5_cleanup_c(base_name, base_namelen, fapl) - + END SUBROUTINE h5_cleanup_f !---------------------------------------------------------------------- -! Name: h5_exit_f +! Name: h5_exit_f ! ! Purpose: Exit application ! It is a fortran counterpart for the standard C 'exit()' routine @@ -239,10 +239,10 @@ END SUBROUTINE h5_cleanup_f ! UNIX supports a very small range such as 1 byte. ! Therefore, exit(256) may end up as exit(0). ! -! Inputs: +! Inputs: ! status - Status to return from application ! -! Outputs: +! Outputs: ! none ! ! Programmer: Quincey Koziol @@ -258,7 +258,7 @@ SUBROUTINE h5_exit_f(status) !DEC$endif IMPLICIT NONE INTEGER, INTENT(IN) :: status ! Return code - + INTERFACE SUBROUTINE h5_exit_c(status) !DEC$ IF DEFINED(HDF5F90_WINDOWS) @@ -267,18 +267,18 @@ SUBROUTINE h5_exit_f(status) INTEGER, INTENT(IN) :: status END SUBROUTINE h5_exit_c END INTERFACE - + CALL h5_exit_c(status) - -END SUBROUTINE h5_exit_f + +END SUBROUTINE h5_exit_f !---------------------------------------------------------------------- -! Name: h5_env_nocleanup_f +! Name: h5_env_nocleanup_f ! -! Purpose: Uses the HDF5_NOCLEANUP environment variable in Fortran +! Purpose: Uses the HDF5_NOCLEANUP environment variable in Fortran ! tests to determine if the output files should be removed ! -! Inputs: +! Inputs: ! ! Outputs: HDF5_NOCLEANUP: .true. - don't remove test files ! .false. - remove test files @@ -305,13 +305,13 @@ SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP) INTEGER :: status END SUBROUTINE h5_env_nocleanup_c END INTERFACE - + CALL h5_env_nocleanup_c(status) HDF5_NOCLEANUP = .FALSE. IF(status.EQ.1)THEN HDF5_NOCLEANUP = .TRUE. ENDIF - + END SUBROUTINE h5_env_nocleanup_f |