[svn-r14923] Maintenance: This check-in merges changes from the fortran_1_8 branch back into the trunk (up to revision 14921)

Platforms tested: kagiso with g95 and Intel compilers; more testing will be done after checking in a fresh
                  copy from the trunk. New code itself was tested with all Fortran compilers available at THG 

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