summaryrefslogtreecommitdiffstats
path: root/fortran/test/tH5A.f90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2008-04-30 19:23:26 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2008-04-30 19:23:26 (GMT)
commit5773fd34bc5adf59b4530d95ac9f0c0585902803 (patch)
tree456ad239799382e1f083fb7fc74399e43b471912 /fortran/test/tH5A.f90
parent0138995d1ce2068db1f790503435a2121132d3ad (diff)
downloadhdf5-5773fd34bc5adf59b4530d95ac9f0c0585902803.zip
hdf5-5773fd34bc5adf59b4530d95ac9f0c0585902803.tar.gz
hdf5-5773fd34bc5adf59b4530d95ac9f0c0585902803.tar.bz2
[svn-r14902] Merged fortran_1_8 branch changes r14505:14901 into the trunk. New fortran wrappers added.
Diffstat (limited to 'fortran/test/tH5A.f90')
-rw-r--r--fortran/test/tH5A.f90111
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