diff options
| -rw-r--r-- | fortran/test/Makefile.in | 2 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.f90 | 234 | ||||
| -rw-r--r-- | fortran/test/tH5A.f90 | 477 | ||||
| -rw-r--r-- | fortran/test/tH5I.f90 | 180 |
4 files changed, 798 insertions, 95 deletions
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index fb8a12e..54e488b 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -23,7 +23,7 @@ TEST_PROGS_SRC=fortranlib_test.f90 fflush1.f90 fflush2.f90 TEST_PROGS=$(TEST_PROGS_SRC:.f90=) TEST_SRC=hdf5test.f90 tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 \ - tH5Sselect.f90 tH5P.f90 + tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 TEST_OBJ=$(TEST_SRC:.f90=.lo) $(TEST_PROGS): $(FLIB) diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 index 40c323b..2724dad 100644 --- a/fortran/test/fortranlib_test.f90 +++ b/fortran/test/fortranlib_test.f90 @@ -4,10 +4,6 @@ ! PROGRAM fortranlibtest - !USE H5FTEST - !USE H5DTEST - !USE H5RTEST - !USE H5STEST USE HDF5 IMPLICIT NONE @@ -26,141 +22,191 @@ INTEGER :: total_error_compoundtest = 0 INTEGER :: basic_datatype_total_error = 0 INTEGER :: external_total_error = 0 + INTEGER :: attribute_total_error = 0 + INTEGER :: identifier_total_error = 0 + CHARACTER*8 error_string + CHARACTER*8 :: success = ' PASSED ' + CHARACTER*8 :: failure = '*FAILED*' + CHARACTER*2 :: e_format = "a8" CALL h5init_types_f(error) - write(*,*) - write(*,*) "Testing File Interface" - + write(*,*) '=============================================================================' + write(*,*) ' FORTRAN tests ' + write(*,*) '=============================================================================' +! write(*,*) '=========================================' +! write(*,*) 'Testing FILE Interface ' +! write(*,*) '=========================================' + + write(*, fmt = '14a', advance = 'no') ' Mounting test' + write(*, fmt = '57x', advance = 'no') + error_string = failure CALL mountingtest(mounting_total_error) - IF (mounting_total_error == 0) THEN - write(*,*) "mounting test OK" - ELSE - write(*,*) "mounting test FAILED" - END IF + IF (mounting_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + mounting_total_error + write(*, fmt = '12a', advance = 'no') ' Reopen test' + write(*, fmt = '59x', advance = 'no') + error_string = failure CALL reopentest(reopen_total_error) - IF (reopen_total_error == 0) THEN - write(*,*) "Reopen test OK" - ELSE - write(*,*) "Reopen test FAILED" - END IF + IF (reopen_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + reopen_total_error +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing DATASET Interface ' +! write(*,*) '=========================================' - write(*,*) - write(*,*) "Testing Dataset Interface" - + write(*, fmt = '13a', advance = 'no') ' Dataset test' + write(*, fmt = '58x', advance = 'no') + error_string = failure CALL datasettest(dataset_total_error) - IF (dataset_total_error == 0) THEN - write(*,*) "dataset test OK" - ELSE - write(*,*) "dataset test FAILED" - END IF + IF (dataset_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + dataset_total_error + write(*, fmt = '24a', advance = 'no') ' Extendible dataset test' + write(*, fmt = '47x', advance = 'no') + error_string = failure CALL extenddsettest(extend_dataset_total_error) - IF (extend_dataset_total_error == 0) THEN - write(*,*) "extend dataset test OK" - ELSE - write(*,*) "extend dataset test FAILED" - END IF + IF (extend_dataset_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + extend_dataset_total_error - write(*,*) - write(*,*) "Testing DATASPACE Interface" +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing DATASPACE Interface ' +! write(*,*) '=========================================' + write(*, fmt = '21a', advance = 'no') ' Basic dataspace test' + write(*, fmt = '50x', advance = 'no') + error_string = failure CALL dataspace_basic_test(dataspace_total_error) - IF (dataspace_total_error == 0) THEN - write(*,*) "dataspce basic test OK" - ELSE - write(*,*) "dataspace basic test FAILED" - END IF + IF (dataspace_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + dataspace_total_error - write(*,*) - write(*,*) "Testing Reference Interface" +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing REFERENCE Interface ' +! write(*,*) '=========================================' + write(*, fmt = '25a', advance = 'no') ' Reference to object test' + write(*, fmt = '46x', advance = 'no') + error_string = failure CALL refobjtest(refobj_total_error) - IF (refobj_total_error == 0) THEN - write(*,*) "Reference to object test OK" - ELSE - write(*,*) "Reference to object test FAILED" - END IF + IF (refobj_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + refobj_total_error + write(*, fmt = '33a', advance = 'no') ' Reference to dataset region test' + write(*, fmt = '38x', advance = 'no') + error_string = failure CALL refregtest(refreg_total_error) - IF (refreg_total_error == 0) THEN - write(*,*) "Refernce to Region test OK" - ELSE - write(*,*) "Refernce to Region test FAILED" - END IF + IF (refreg_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + refreg_total_error - write(*,*) - write(*,*) "Testing selection functionalities" +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing selection functionalities ' +! write(*,*) '=========================================' + write(*, fmt = '21a', advance = 'no') ' Basic selection test' + write(*, fmt = '50x', advance = 'no') + error_string = failure + CALL test_basic_select(basic_select_total_error) + IF (basic_select_total_error == 0) error_string = success + write(*, fmt = e_format) error_string + total_error = total_error + basic_select_total_error + + write(*, fmt = '25a', advance = 'no') ' Hyperslab selection test' + write(*, fmt = '46x', advance = 'no') + error_string = failure CALL test_select_hyperslab( hyperslab_total_error) - IF ( hyperslab_total_error == 0) THEN - write(*,*) "hyperslab selection test OK" - ELSE - write(*,*) "hyperslab selection test FAILED" - END IF + IF ( hyperslab_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + hyperslab_total_error + write(*, fmt = '23a', advance = 'no') ' Element selection test' + write(*, fmt = '48x', advance = 'no') + error_string = failure CALL test_select_element(element_total_error) - IF (element_total_error == 0) THEN - write(*,*) "element selection test OK" - ELSE - write(*,*) "element selection test FAILED" - END IF + IF (element_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + element_total_error - CALL test_basic_select(basic_select_total_error) - IF (basic_select_total_error == 0) THEN - write(*,*) "basic selection test OK" - ELSE - write(*,*) "basic selection test FAILED" - END IF - total_error = total_error + basic_select_total_error - write(*,*) - write(*,*) "Testing Compound Datatypes" - CALL compoundtest(total_error_compoundtest) - IF (total_error_compoundtest == 0) THEN - write(*,*) "Compound Datatype test OK" - ELSE - write(*,*) "Compound Datatype test FAILED" - END IF - total_error = total_error + total_error_compoundtest +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing DATATYPE interface ' +! write(*,*) '=========================================' - write(*,*) - write(*,*) "Testing basic datatype functionalities" + write(*, fmt = '20a', advance = 'no') ' Basic datatype test' + write(*, fmt = '51x', advance = 'no') + error_string = failure CALL basic_data_type_test(basic_datatype_total_error) - IF (basic_datatype_total_error == 0) THEN - write(*,*) "Basic Datatype test OK" - ELSE - write(*,*) "Basic Datatype test FAILED" - END IF + IF (basic_datatype_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + basic_datatype_total_error - write(*,*) - write(*,*) "Testing external functionalities" + write(*, fmt = '23a', advance = 'no') ' Compound datatype test' + write(*, fmt = '48x', advance = 'no') + error_string = failure + CALL compoundtest(total_error_compoundtest) + IF (total_error_compoundtest == 0) error_string = success + write(*, fmt = e_format) error_string + total_error = total_error + total_error_compoundtest + +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing PROPERTY interface ' +! write(*,*) '=========================================' + + write(*, fmt = '22a', advance = 'no') ' External dataset test' + write(*, fmt = '49x', advance = 'no') + error_string = failure CALL external_test(external_total_error) - IF (external_total_error == 0) THEN - write(*,*) "External test OK" - ELSE - write(*,*) "External test FAILED" - END IF + IF (external_total_error == 0) error_string = success + write(*, fmt = e_format) error_string total_error = total_error + external_total_error + +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing ATTRIBUTE interface ' +! write(*,*) '=========================================' + + write(*, fmt = '15a', advance = 'no') ' Attribute test' + write(*, fmt = '56x', advance = 'no') + error_string = failure + CALL attribute_test(attribute_total_error) + IF (attribute_total_error == 0) error_string = success + write(*, fmt = e_format) error_string + total_error = total_error + attribute_total_error + +! write(*,*) +! write(*,*) '=========================================' +! write(*,*) 'Testing IDENTIFIER interface ' +! write(*,*) '=========================================' + + write(*, fmt = '16a', advance = 'no') ' Identifier test' + write(*, fmt = '55x', advance = 'no') + error_string = failure + CALL identifier_test(identifier_total_error) + IF (identifier_total_error == 0) error_string = success + write(*, fmt = e_format) error_string + total_error = total_error + identifier_total_error write(*,*) - if (total_error .eq. 0) write(*,*) "Fortran_lib test passed!" - if (total_error.gt. 0) write(*,*) "Fortran_lib test failed with ",& - total_error, " error(s)" + write(*,*) '=============================================================================' + write(*, fmt = "15x, 27a", advance='NO') ' FORTRAN tests completed with ' + write(*, fmt = "i4", advance='NO') total_error + write(*, fmt = "12a" ) ' error(s) ! ' + write(*,*) '=============================================================================' CALL h5close_types_f(error) diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 new file mode 100644 index 0000000..7bd61b4 --- /dev/null +++ b/fortran/test/tH5A.f90 @@ -0,0 +1,477 @@ + + SUBROUTINE attribute_test(total_error) + +!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 + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=8), PARAMETER :: filename = "atest.h5" !File name + CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name + CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name + CHARACTER(LEN=13), PARAMETER :: aname2 = "attr_character"!Character Attribute name + CHARACTER(LEN=11), PARAMETER :: aname3 = "attr_double" !DOuble Attribute name + CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name + CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 + + + + 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) :: aspace_id !String Attribute Dataspace identifier + INTEGER(HID_T) :: aspace2_id !Character Attribute Dataspace identifier + INTEGER(HID_T) :: aspace3_id !Double Attribute Dataspace identifier + INTEGER(HID_T) :: aspace4_id !Real Attribute Dataspace identifier + INTEGER(HID_T) :: aspace5_id !Integer 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_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 :: num_attrs !number of attributes + CHARACTER*256 :: attr_name !buffer to put attr_name + INTEGER :: name_size = 80 !attribute name length + + CHARACTER*80, DIMENSION(2) :: attr_data ! Attribute data + CHARACTER :: attr_character_data = 'A' + DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459 + REAL, DIMENSION(1) :: attr_real_data = 4.0 + INTEGER, DIMENSION(1) :: attr_integer_data = 5 + + CHARACTER*80, DIMENSION(2) :: aread_data ! buffer to put read back + !string attr data + + 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 + DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data + REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data + + ! + !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 + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out + + + ! + !Initialize data_in buffer + ! + do i = 1, NX + do j = 1, NY + data_in(i,j) = (i-1) + (j-1) + end do + end do + ! + ! Initialize attribute's data + ! + attr_data(1) = "Dataset character attribute" + attr_data(2) = "Some other string here " + attrlen = 80 + + ! + ! Create the file. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + ! create dataset in the file. + ! + CALL h5dcreate_f(file_id, dsetname, 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, error) + CALL check("h5dwrite_f",error,total_error) + + ! + ! 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. + ! + CALL h5screate_simple_f(arank, adims2, aspace2_id, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + ! Create datatype for the String attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) + CALL check("h5tcopy_f",error,total_error) + + CALL h5tset_size_f(atype_id, attrlen, error) + CALL check("h5tset_size_f",error,total_error) + + ! + ! Create datatype for the Character attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype2_id, error) + CALL check("h5tcopy_f",error,total_error) + ! + ! Create datatype for the DOulble attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_DOUBLE, atype3_id, error) + CALL check("h5tcopy_f",error,total_error) + ! + ! Create datatype for the Real attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_REAL, atype4_id, error) + CALL check("h5tcopy_f",error,total_error) + ! + ! Create datatype for the Integer attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_INTEGER, atype5_id, error) + CALL check("h5tcopy_f",error,total_error) + + + ! + ! Create dataset String attribute. + ! + CALL h5acreate_f(dset_id, aname, atype_id, aspace_id, & + attr_id, error) + CALL check("h5acreate_f",error,total_error) + + + ! + ! Create dataset CHARACTER attribute. + ! + CALL h5acreate_f(dset_id, aname2, atype2_id, aspace2_id, & + attr2_id, error) + CALL check("h5acreate_f",error,total_error) + + + ! + ! Create dataset DOUBLE attribute. + ! + CALL h5acreate_f(dset_id, aname3, atype3_id, aspace2_id, & + attr3_id, error) + CALL check("h5acreate_f",error,total_error) + ! + ! Create dataset REAL attribute. + ! + CALL h5acreate_f(dset_id, aname4, atype4_id, aspace2_id, & + attr4_id, error) + CALL check("h5acreate_f",error,total_error) + ! + ! Create dataset INTEGER attribute. + ! + CALL h5acreate_f(dset_id, aname5, atype5_id, aspace2_id, & + attr5_id, error) + CALL check("h5acreate_f",error,total_error) + + ! + ! Write the String attribute data. + ! + CALL h5awrite_f(attr_id, atype_id, attr_data, error) + CALL check("h5awrite_f",error,total_error) + ! + ! Write the Character attribute data. + ! + CALL h5awrite_f(attr2_id, atype2_id, attr_character_data, error) + CALL check("h5awrite_f",error,total_error) + ! + ! Write the DOUBLE attribute data. + ! + CALL h5awrite_f(attr3_id, atype3_id, attr_double_data, error) + CALL check("h5awrite_f",error,total_error) + ! + ! Write the Real attribute data. + ! + CALL h5awrite_f(attr4_id, atype4_id, attr_real_data, error) + CALL check("h5awrite_f",error,total_error) + + ! + ! Write the Integer attribute data. + ! + CALL h5awrite_f(attr5_id, atype5_id, attr_integer_data, error) + CALL check("h5awrite_f",error,total_error) + + ! + ! Close the attribute. + ! + CALL h5aclose_f(attr_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr2_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr3_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr4_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr5_id, error) + CALL check("h5aclose_f",error,total_error) + + CALL h5tclose_f(atype_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(atype2_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(atype3_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(atype4_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(atype5_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(aspace_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(aspace2_id, error) + CALL check("h5sclose_f",error,total_error) + + ! + !open the String attrbute by name + ! + CALL h5aopen_name_f(dset_id, aname, attr_id, error) + CALL check("h5aopen_name_f",error,total_error) + + ! + !open the CHARACTER attrbute by name + ! + CALL h5aopen_name_f(dset_id, aname2, attr2_id, error) + CALL check("h5aopen_name_f",error,total_error) + ! + !open the DOUBLE attrbute by name + ! + CALL h5aopen_name_f(dset_id, aname3, attr3_id, error) + CALL check("h5aopen_name_f",error,total_error) + ! + !open the REAL attrbute by name + ! + CALL h5aopen_name_f(dset_id, aname4, attr4_id, error) + CALL check("h5aopen_name_f",error,total_error) + + CALL h5aopen_idx_f(dset_id, 4, attr5_id, error) + CALL check("h5aopen_idx_f",error,total_error) + + ! + !get the attrbute name + ! + CALL h5aget_name_f(attr5_id, name_size, attr_name, error) + CALL check("h5aget_name_f",error,total_error) +!Can I DO STRCMP LIKE THIS? + if (attr_name(1:name_size) .ne. aname5) then + write(*,*) "Get attr name is ", attr_name + total_error = total_error + 1 + end if + + ! + !get the STRING attrbute space + ! + CALL h5aget_space_f(attr_id, attr_space, error) + CALL check("h5aget_space_f",error,total_error) + ! + !get other attrbute space + ! + CALL h5aget_space_f(attr2_id, attr2_space, error) + CALL check("h5aget_space_f",error,total_error) + ! + !get the string attrbute datatype + ! + CALL h5aget_type_f(attr_id, attr_type, error) + CALL check("h5aget_type_f",error,total_error) + ! + !get the character attrbute datatype + ! + CALL h5aget_type_f(attr2_id, attr2_type, error) + CALL check("h5aget_type_f",error,total_error) + ! + !get the double attrbute datatype + ! + CALL h5aget_type_f(attr3_id, attr3_type, error) + CALL check("h5aget_type_f",error,total_error) + ! + !get the real attrbute datatype + ! + CALL h5aget_type_f(attr4_id, attr4_type, error) + CALL check("h5aget_type_f",error,total_error) + + ! + !get the integer attrbute datatype + ! + CALL h5aget_type_f(attr5_id, attr5_type, error) + CALL check("h5aget_type_f",error,total_error) + + ! + !get number of attributes + ! + CALL h5aget_num_attrs_f(dset_id, num_attrs, error) + CALL check("h5aget_num_attrs_f",error,total_error) + if (num_attrs .ne. 5) then + write(*,*) "got number of attributes wrong", num_attrs + total_error = total_error +1 + end if + + ! + !set the read back data type's size + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, atype_id, error) + CALL check("h5tcopy_f",error,total_error) + + CALL h5tset_size_f(atype_id, attrlen, error) + CALL check("h5tset_size_f",error,total_error) + ! + !read the string attribute data back to memory + ! + CALL h5aread_f(attr_id, atype_id, aread_data, error) + CALL check("h5aread_f",error,total_error) + + 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 + end if + + ! + !read the CHARACTER attribute data back to memory + ! + CALL h5aread_f(attr2_id, H5T_NATIVE_CHARACTER, aread_character_data, error) + 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 + end if + ! + !read the double attribute data back to memory + ! + CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, 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 + ! + !read the real attribute data back to memory + ! + CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, 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 + ! + !read the Integer attribute data back to memory + ! + CALL h5aread_f(attr5_id, H5T_NATIVE_INTEGER, aread_integer_data, 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 + + ! + ! Close the attribute. + ! + CALL h5aclose_f(attr_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr2_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr3_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr4_id, error) + CALL check("h5aclose_f",error,total_error) + CALL h5aclose_f(attr5_id, error) + CALL check("h5aclose_f",error,total_error) + + ! + ! Delete the attribute from the Dataset. + ! + CALL h5adelete_f(dset_id, aname, error) + CALL check("h5adelete_f",error,total_error) + + ! + !get number of attributes + ! + CALL h5aget_num_attrs_f(dset_id, num_attrs, error) + CALL check("h5aget_num_attrs_f",error,total_error) + if (num_attrs .ne. 4) then + write(*,*) "got number of attributes wrong", num_attrs + total_error = total_error +1 + end if + + + + CALL h5sclose_f(attr_space, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(attr2_space, error) + CALL check("h5sclose_f",error,total_error) + + ! + ! Terminate access to the data type. + ! + CALL h5tclose_f(attr_type, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(attr2_type, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(attr3_type, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(attr4_type, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(attr5_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) + CALL check("h5fclose_f",error,total_error) + + RETURN + END SUBROUTINE attribute_test diff --git a/fortran/test/tH5I.f90 b/fortran/test/tH5I.f90 new file mode 100644 index 0000000..075c26f --- /dev/null +++ b/fortran/test/tH5I.f90 @@ -0,0 +1,180 @@ + SUBROUTINE identifier_test(total_error) + +!THis subroutine tests following functionalities: h5iget_type_f + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=9), PARAMETER :: filename = "itestf.h5" ! File name + CHARACTER(LEN=9), 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) :: 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(HSIZE_T), DIMENSION(1) :: dims = 1 ! Datasets dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: adims = 1 ! Attribute dimensions + + INTEGER, DIMENSION(1) :: attr_data = 12 + INTEGER :: rank = 1 ! Datasets rank + INTEGER :: arank = 1 ! Attribute rank + + INTEGER :: type !object identifier + INTEGER :: error ! Error flag + + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + ! Create a group named "/MyGroup" in the file. + ! + CALL h5gcreate_f(file_id, groupname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! + !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. + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, error) + CALL check("h5dwrite_f",error,total_error) + + ! + ! Create scalar data space for dataset attribute. + ! + CALL h5screate_simple_f(arank, adims, aspace_id, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + ! Create datatype for the Integer attribute. + ! + CALL h5tcopy_f(H5T_NATIVE_INTEGER, atype_id, error) + CALL check("h5tcopy_f",error,total_error) + + ! + ! Create dataset INTEGER attribute. + ! + CALL h5acreate_f(dset_id, aname, atype_id, aspace_id, & + attr_id, error) + CALL check("h5acreate_f",error,total_error) + + ! + ! Write the Integer attribute data. + ! + CALL h5awrite_f(attr_id, atype_id, attr_data, error) + CALL check("h5awrite_f",error,total_error) + + ! + !Get the file identifier + ! + CALL h5iget_type_f(file_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_FILE_F) then + write(*,*) "get file identifier wrong" + total_error = total_error + 1 + end if + ! + !Get the group identifier + ! + CALL h5iget_type_f(group_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_GROUP_F) then + write(*,*) "get group identifier wrong",type + total_error = total_error + 1 + end if + ! + !Get the datatype identifier + ! + CALL h5iget_type_f(atype_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_DATATYPE_F) then + write(*,*) "get datatype identifier wrong",type + total_error = total_error + 1 + end if + ! + !Get the dataspace identifier + ! + CALL h5iget_type_f(aspace_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_DATASPACE_F) then + write(*,*) "get dataspace identifier wrong",type + total_error = total_error + 1 + end if + ! + !Get the dataset identifier + ! + CALL h5iget_type_f(dset_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_DATASET_F) then + write(*,*) "get dataset identifier wrong",type + total_error = total_error + 1 + end if + ! + !Get the attribute identifier + ! + CALL h5iget_type_f(attr_id, type, error) + CALL check("h5iget_type_f",error,total_error) + if (type .ne. H5I_ATTR_F) then + write(*,*) "get attribute identifier wrong",type + total_error = total_error + 1 + end if + + ! + ! 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 file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + RETURN + END SUBROUTINE identifier_test |