diff options
Diffstat (limited to 'fortran/test/tH5A.f90')
| -rw-r--r-- | fortran/test/tH5A.f90 | 111 |
1 files changed, 67 insertions, 44 deletions
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index 44c7964..b73dd8a 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -56,10 +56,7 @@ 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) :: 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) :: 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 @@ -79,7 +76,8 @@ 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 @@ -113,32 +111,32 @@ ! !data buffers ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out + INTEGER, DIMENSION(NX,NY) :: data_in ! !Initialize data_in buffer ! - do i = 1, NX - do j = 1, NY + DO i = 1, NX + DO j = 1, NY data_in(i,j) = (i-1) + (j-1) - end do - end do + END DO + END DO ! ! Initialize attribute's data ! attr_data(1) = 'Dataset character attribute' attr_data(2) = 'Some other string here ' - attrlen = len(attr_data(1)) + attrlen = LEN(attr_data(1)) ! ! Create the file. ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify file name" + STOP + ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) @@ -247,8 +245,10 @@ ! ! Create dataset NULL attribute of INTEGER. ! + CALL h5acreate_f(dset_id, aname6, atype5_id, aspace6_id, & attr6_id, error) + CALL check("h5acreate_f",error,total_error) ! @@ -287,6 +287,29 @@ ! CALL h5awrite_f(attr6_id, atype5_id, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) + + ! + ! check the amount of storage that is required for the specified attribute .MSB. + ! + CALL h5aget_storage_size_f(attr_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL VERIFY("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error) + CALL h5aget_storage_size_f(attr2_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,1,total_error) + CALL h5aget_storage_size_f(attr3_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,8,total_error) + CALL h5aget_storage_size_f(attr4_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,4,total_error) + CALL h5aget_storage_size_f(attr5_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,4,total_error) + CALL h5aget_storage_size_f(attr6_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,0,total_error) + ! ! Close the attribute. @@ -383,12 +406,12 @@ ! CALL h5aget_name_f(attr5_id, name_size, attr_name, error) CALL check("h5aget_name_f",error,total_error) - if (attr_name(1:12) .ne. aname5) then + IF (attr_name(1:12) .NE. aname5) THEN total_error = total_error + 1 - end if - if (error .ne. 12) then + END IF + IF (error .NE. 12) THEN total_error = total_error + 1 - end if + END IF ! !get the STRING attrbute space @@ -438,10 +461,10 @@ ! CALL h5aget_num_attrs_f(dset_id, num_attrs, error) CALL check("h5aget_num_attrs_f",error,total_error) - if (num_attrs .ne. 6) then - write(*,*) "got number of attributes wrong", num_attrs + IF (num_attrs .NE. 6) THEN + WRITE(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 - end if + END IF ! !set the read back data type's size @@ -458,60 +481,60 @@ CALL h5aread_f(attr_id, atype_id, aread_data, data_dims, 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) + 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 + END IF ! !read the CHARACTER attribute data back to memory ! CALL h5aread_f(attr2_id, H5T_NATIVE_CHARACTER, aread_character_data, data_dims, 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 + IF (aread_character_data .NE. 'A' ) THEN + WRITE(*,*) "Read back character attrbute is wrong ",aread_character_data total_error = total_error + 1 - end if + END IF ! !read the double attribute data back to memory ! 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) + 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 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 + 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 + END IF ! !read the Integer attribute data back to memory ! 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 + 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 + END IF ! !read the null attribute data. nothing can be read. ! 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 + 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 + END IF ! ! Close the attribute. @@ -540,10 +563,10 @@ ! 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 + IF (num_attrs .NE. 5) THEN + WRITE(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 - end if + END IF @@ -582,7 +605,7 @@ ! ! Remove the file ! - if (cleanup) call h5_cleanup_f(filename, H5P_DEFAULT_F, error) + IF (cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) RETURN END SUBROUTINE attribute_test |