[svn-r2958]

Purpose:
    Code development and maintenance
Description:
    Four new fortran functions to support array datatype were added:
         h5tarray_create_f
         h5tget_array_ndims_f
         h5tget_array_dims_f
         h5tget_super_f

    Two functions were deleted (commented out for now, can be returned easily if
    necessary):
         h5tinsert_array_f
         h5tget_member_dims
Platforms tested:
        Library build was tested on Solaris2.6. I have to modify test program to
        use new functions. Right now test program will not compile.

3 files changed, 269 insertions, 39 deletions

diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c
index e1757f8..1932a56 100644
--- a/fortran/src/H5Tf.c
+++ b/fortran/src/H5Tf.c
@@ -1031,7 +1031,8 @@ nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f * offset)
  * Returns:     0 on success, -1 on failure
  * Programmer:  XIANGYANG SU
  *              Thursday, February 3, 2000
- * Modifications:
+ * Modifications: WANT_H5_V1_2_COMPAT added for backward compatibility
+ *                November 16, 2000 EP
  *---------------------------------------------------------------------------*/
 
 int_f 
@@ -1044,6 +1045,8 @@ nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t
   size_t * c_field_dims;
   int c_field_idx;
 
+#ifdef WANT_H5_V1_2_COMPAT
+
   c_field_dims = (size_t*)malloc(sizeof(size_t)*4);
   if(!c_field_dims) return ret_value;
 
@@ -1065,10 +1068,114 @@ nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t
   ret_value = 0; 
   HDfree(c_field_dims);
   HDfree(c_perm);
+
+#endif /* WANT_H5_V1_2_COMPAT */
+
+  return ret_value;
+}
+
+/*----------------------------------------------------------------------------
+ * Name:        h5tget_array_dims_c
+ * Purpose:     Call H5Tget_array_dims to get  
+ *              dimensions of array datatype
+ * Inputs:      type_id - identifier of the array datatype
+ * Outputs:     dims -  dimensions(sizes of dimensions) of the array
+ * Returns:     0 on success, -1 on failure
+ * Programmer:  Elena Pourmal
+ *              Thursday, November 16, 2000
+ * Modifications: 
+ *---------------------------------------------------------------------------*/
+
+int_f 
+nh5tget_array_dims_c ( hid_t_f *type_id , hsize_t_f * dims)
+{
+  int ret_value = -1;
+  hid_t c_type_id;
+  hsize_t * c_dims;
+  int rank, i;
+  herr_t status;
+
+  rank = H5Tget_array_ndims((hid_t)*type_id);
+  if (rank < 0) return ret_value;
+  c_dims = (hsize_t*)malloc(sizeof(hsize_t)*rank);
+  if(!c_dims) return ret_value;
+
+  c_type_id = (hid_t)*type_id;
+  status = H5Tget_array_dims(c_type_id, c_dims, NULL);
+  if (status < 0) {
+             HDfree(c_dims);
+             return ret_value;
+  }
+
+  for(i =0; i < rank; i++)
+  {
+      dims[rank-i-1] = (hsize_t_f)c_dims[i];
+  }
+
+  ret_value = 0; 
+  HDfree(c_dims);
+
   return ret_value;
 }
 
 /*----------------------------------------------------------------------------
+ * Name:        h5tget_array_ndims_c
+ * Purpose:     Call H5Tget_array_ndims to get number 
+ *              of dimensions of array datatype
+ * Inputs:      type_id - identifier of the array datatype
+ * Outputs:     ndims -  number of dimensions of the array
+ * Returns:     0 on success, -1 on failure
+ * Programmer:  Elena Pourmal
+ *              Thursday, November 16, 2000
+ * Modifications: 
+ *---------------------------------------------------------------------------*/
+
+int_f 
+nh5tget_array_ndims_c ( hid_t_f *type_id , int_f * ndims)
+{
+  int ret_value = -1;
+  hid_t c_type_id;
+  int c_ndims;
+
+  c_type_id = (hid_t)*type_id;
+  c_ndims = H5Tget_array_ndims(c_type_id);
+  if (c_ndims < 0) return ret_value;
+
+  *ndims = (int_f)c_ndims;
+  ret_value = 0; 
+  return ret_value;
+}
+
+/*----------------------------------------------------------------------------
+ * Name:        h5tget_super_c
+ * Purpose:     Call H5Tget_super to get base datatype from which 
+ *              datatype was derived 
+ * Inputs:      type_id - identifier of the array datatype
+ * Outputs:     base_type_id - base datatype identifier 
+ * Returns:     0 on success, -1 on failure
+ * Programmer:  Elena Pourmal
+ *              Thursday, November 16, 2000
+ * Modifications: 
+ *---------------------------------------------------------------------------*/
+
+int_f 
+nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id)
+{
+  int ret_value = -1;
+  hid_t c_type_id;
+  hid_t c_base_type_id;
+
+  c_type_id = (hid_t)*type_id;
+  c_base_type_id = H5Tget_super(c_type_id);
+  if (c_base_type_id < 0) return ret_value;
+
+  *base_type_id = (hid_t_f)c_base_type_id;
+  ret_value = 0; 
+  return ret_value;
+}
+
+
+/*----------------------------------------------------------------------------
  * Name:        h5tget_member_type_c
  * Purpose:     Call H5Tget_member_type to get the identifier of a copy of
  *              the datatype of the field
@@ -1210,7 +1317,8 @@ nh5tpack_c(hid_t_f * type_id)
  * Returns:     0 on success, -1 on failure
  * Programmer:  XIANGYANG SU
  *              Thursday, February 3, 2000
- * Modifications:
+ * Modifications: WANT_H5_V1_2_COMPAT added for backward compatibility
+ *                November 16, 2000 EP
  *---------------------------------------------------------------------------*/
 int_f
 nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id, int_f* perm )
@@ -1226,6 +1334,7 @@ nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* off
   int c_namelen;
   int * c_perm, i;
 
+#ifdef WANT_H5_V1_2_COMPAT
   c_offset = *offset;   
   c_dims = (size_t*)malloc(sizeof(size_t)*(*ndims));
   if(!c_dims) return ret_value;
@@ -1252,6 +1361,7 @@ nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* off
   if(status < 0) return ret_value;
   ret_value = 0;
 
+#endif /* WANT_H5_V1_2_COMPAT */
   return ret_value;
 
 }
@@ -1274,7 +1384,8 @@ nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* off
  * Returns:     0 on success, -1 on failure
  * Programmer:  XIANGYANG SU
  *              Thursday, February 3, 2000
- * Modifications:
+ * Modifications: WANT_H5_V1_2_COMPAT added for backward compatibility
+ *                November 16, 2000 EP
  *---------------------------------------------------------------------------*/
 int_f
 nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id )
@@ -1290,6 +1401,8 @@ nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* of
   int c_namelen;
   int i;
 
+#ifdef WANT_H5_V1_2_COMPAT
+
   c_offset = *offset;   
   c_dims = (size_t*)malloc(sizeof(size_t)*(*ndims));
   if(!c_dims) return ret_value;
@@ -1312,9 +1425,61 @@ nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* of
   if(status < 0) return ret_value;
   ret_value = 0;
 
+#endif /* WANT_H5_V1_2_COMPAT */
+
   return ret_value;
 
 }
+/*----------------------------------------------------------------------------
+ * Name:        h5tarray_create_c
+ * Purpose:     Call H5Tcreate_array to create array datatype
+ * Inputs:      base_id - identifier of array base datatype
+ *              rank - array's rank
+ *              dims - Size of new member array
+ *              type_id - identifier of the array datatype
+ * Returns:     0 on success, -1 on failure
+ * Programmer:  Elena Pourmal 
+ *              Thursday, November 16, 2000
+ * Modifications: 
+ *---------------------------------------------------------------------------*/
+int_f
+nh5tarray_create_c(hid_t_f * base_id, int_f *rank, hsize_t_f* dims, hid_t_f* type_id)
+{
+  int ret_value = -1;
+  hid_t c_base_id;
+  hid_t c_type_id;
+  int c_rank;
+  herr_t status;
+  hsize_t *c_dims;
+  int i;
+
+  c_dims = (hsize_t*)malloc(sizeof(hsize_t)*(*rank));
+  if(!c_dims) return ret_value;
+
+
+  /*
+   * Transpose dimension arrays because of C-FORTRAN storage order
+   */
+  for (i = 0; i < *rank ; i++) {
+     c_dims[i] =  (hsize_t)dims[*rank - i - 1];
+  }
+  
+  c_base_id = (hid_t)*base_id;
+  c_rank = (int)*rank;
+  c_type_id = H5Tcreate_array(c_base_id, c_rank, c_dims, NULL);
+
+  if(c_type_id < 0) {
+          HDfree(c_dims);
+          return ret_value;
+  }
+
+  *type_id = (hid_t_f)c_type_id;
+  ret_value = 0;
+  HDfree(c_dims);
+  return ret_value;
+
+}
+
 
 /*----------------------------------------------------------------------------
  * Name:        h5tenum_create_c
diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90
index 5560dc8..2b86c57 100644
--- a/fortran/src/H5Tff.f90
+++ b/fortran/src/H5Tff.f90
@@ -425,22 +425,57 @@
             hdferr = h5tget_member_offset_c(type_id, member_no, offset )
           END SUBROUTINE h5tget_member_offset_f
 
-          SUBROUTINE h5tget_member_dims_f(type_id, field_idx,dims, field_dims, perm, hdferr) 
+!          SUBROUTINE h5tget_member_dims_f(type_id, field_idx,dims, field_dims, perm, hdferr) 
+!            IMPLICIT NONE
+!            INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier 
+!            INTEGER, INTENT(IN) :: field_idx !Field index (0-based) of 
+!                                             !field_dims, perm)
+!            INTEGER, INTENT(OUT) :: dims     !number of dimensions of the field
+!
+!            INTEGER(SIZE_T),DIMENSION(*), INTENT(OUT) ::  field_dims !buffer to store the 
+!                                                                      !dimensions of the field
+!            INTEGER, DIMENSION(*), INTENT(OUT)  ::  perm  !buffer to store the 
+!                                                                   !permutation vector of the field
+!            INTEGER, INTENT(OUT) :: hdferr        ! Error code
+!            INTEGER, EXTERNAL :: h5tget_member_dims_c
+!            hdferr = h5tget_member_dims_c(type_id, field_idx, dims, field_dims, perm)
+!
+!          END SUBROUTINE h5tget_member_dims_f
+
+          SUBROUTINE h5tget_array_dims_f(type_id, dims, hdferr) 
+
             IMPLICIT NONE
-            INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier 
-            INTEGER, INTENT(IN) :: field_idx !Field index (0-based) of 
-                                             !field_dims, perm)
-            INTEGER, INTENT(OUT) :: dims     !number of dimensions of the field
+            INTEGER(HID_T), INTENT(IN) :: type_id ! Array datatype identifier 
+            INTEGER(HSIZE_T),DIMENSION(*), INTENT(OUT) ::  dims !buffer to store array datatype
+                                                                ! dimensions 
+            INTEGER, INTENT(OUT) :: hdferr        ! Error code
+            INTEGER, EXTERNAL :: h5tget_array_dims_c
+            hdferr = h5tget_array_dims_c(type_id, dims)
+
+          END SUBROUTINE h5tget_array_dims_f
+
+          SUBROUTINE h5tget_array_ndims_f(type_id, ndims, hdferr) 
 
-            INTEGER(SIZE_T),DIMENSION(*), INTENT(OUT) ::  field_dims !buffer to store the 
-                                                                      !dimensions of the field
-            INTEGER, DIMENSION(*), INTENT(OUT)  ::  perm  !buffer to store the 
-                                                                   !permutation vector of the field
+            IMPLICIT NONE
+            INTEGER(HID_T), INTENT(IN) :: type_id ! Array datatype identifier 
+            INTEGER, INTENT(OUT) ::  ndims ! number of array dimensions
             INTEGER, INTENT(OUT) :: hdferr        ! Error code
-            INTEGER, EXTERNAL :: h5tget_member_dims_c
-            hdferr = h5tget_member_dims_c(type_id, field_idx, dims, field_dims, perm)
+            INTEGER, EXTERNAL :: h5tget_array_ndims_c
+            hdferr = h5tget_array_ndims_c(type_id, ndims)
+
+          END SUBROUTINE h5tget_array_ndims_f
 
-          END SUBROUTINE h5tget_member_dims_f
+          SUBROUTINE h5tget_super_f(type_id, base_type_id, hdferr) 
+
+            IMPLICIT NONE
+            INTEGER(HID_T), INTENT(IN) :: type_id ! datatype identifier 
+            INTEGER(HID_T), INTENT(OUT) :: base_type_id ! identifier of the datatype
+                                           ! from which datatype (type_id) was derived
+            INTEGER, INTENT(OUT) :: hdferr        ! Error code
+            INTEGER, EXTERNAL :: h5tget_super_c
+            hdferr = h5tget_super_c(type_id, base_type_id)
+
+          END SUBROUTINE h5tget_super_f
 
           SUBROUTINE h5tget_member_type_f(type_id,  field_idx, datatype, hdferr) 
             IMPLICIT NONE
@@ -490,32 +525,45 @@
             hdferr = h5tpack_c(type_id) 
           END SUBROUTINE h5tpack_f
 
-          SUBROUTINE h5tinsert_array_f(parent_id,name,offset, ndims, dims, member_id, hdferr, perm) 
+!          SUBROUTINE h5tinsert_array_f(parent_id,name,offset, ndims, dims, member_id, hdferr, perm) 
+!            IMPLICIT NONE
+!            INTEGER(HID_T), INTENT(IN) :: parent_id ! identifier of the parent compound datatype
+!            CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member
+!            INTEGER(SIZE_T), INTENT(IN) :: offset !Offset to start of new member 
+!                                                   !within compound datatype
+!            INTEGER, INTENT(IN) ::  ndims !Dimensionality of new member. 
+!                                          !Valid values are 0 (zero) through 4 (four)
+!            INTEGER(SIZE_T), DIMENSION(*), INTENT(IN) :: dims !Size of new member array
+!            INTEGER(HID_T), INTENT(IN) :: member_id ! identifier of the datatype of the new member
+!            INTEGER, INTENT(OUT) :: hdferr        ! Error code
+!
+!            INTEGER, DIMENSION(*), OPTIONAL, INTENT(IN) :: perm 
+!                                                               !Pointer to buffer to store 
+!                                                               !the permutation vector of the field
+!            INTEGER :: namelen, sizeofperm
+!            INTEGER, EXTERNAL :: h5tinsert_array_c,  h5tinsert_array_c2
+!            namelen = LEN(name)
+!            if (present(perm)) then
+!              hdferr = h5tinsert_array_c(parent_id, name, namelen, offset, ndims,dims, member_id, perm)
+!            else
+!              hdferr = h5tinsert_array_c2(parent_id, name, namelen, offset, ndims,dims, member_id)  
+!            end if           
+!           
+!         END SUBROUTINE h5tinsert_array_f
+         
+          SUBROUTINE h5tarray_create_f(base_id, rank, dims, type_id, hdferr) 
             IMPLICIT NONE
-            INTEGER(HID_T), INTENT(IN) :: parent_id ! identifier of the parent compound datatype
-            CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member
-            INTEGER(SIZE_T), INTENT(IN) :: offset !Offset to start of new member 
-                                                   !within compound datatype
-            INTEGER, INTENT(IN) ::  ndims !Dimensionality of new member. 
-                                          !Valid values are 0 (zero) through 4 (four)
-            INTEGER(SIZE_T), DIMENSION(*), INTENT(IN) :: dims !Size of new member array
-            INTEGER(HID_T), INTENT(IN) :: member_id ! identifier of the datatype of the new member
+            INTEGER(HID_T), INTENT(IN) :: base_id ! identifier of array base datatype
+            INTEGER, INTENT(IN) ::  rank ! Rank of the array
+            INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: dims !Sizes of each array dimension
+            INTEGER(HID_T), INTENT(OUT) :: type_id ! identifier of the array datatype 
             INTEGER, INTENT(OUT) :: hdferr        ! Error code
 
-            INTEGER, DIMENSION(*), OPTIONAL, INTENT(IN) :: perm 
-                                                               !Pointer to buffer to store 
-                                                               !the permutation vector of the field
-            INTEGER :: namelen, sizeofperm
-            INTEGER, EXTERNAL :: h5tinsert_array_c,  h5tinsert_array_c2
-            namelen = LEN(name)
-            if (present(perm)) then
-              hdferr = h5tinsert_array_c(parent_id, name, namelen, offset, ndims,dims, member_id, perm)
-            else
-              hdferr = h5tinsert_array_c2(parent_id, name, namelen, offset, ndims,dims, member_id)  
-            end if           
+            INTEGER, EXTERNAL :: h5tarray_create_c
+              hdferr = h5tarray_create_c(base_id, rank, dims, type_id)
            
-         END SUBROUTINE h5tinsert_array_f
-         
+         END SUBROUTINE h5tarray_create_f
+
           SUBROUTINE h5tenum_create_f(parent_id, new_type_id, hdferr) 
             IMPLICIT NONE
             INTEGER(HID_T), INTENT(IN) :: parent_id  ! Datatype identifier for
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 6369876..e252344 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -424,8 +424,13 @@ extern int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
 #   define nh5tenum_nameof_c             FNAME(H5TENUM_NAMEOF_C)
 #   define nh5tenum_valueof_c             FNAME(H5TENUM_VALUEOF_C)
 #   define nh5tget_member_value_c         FNAME(H5TGET_MEMBER_VALUE_C)
-#   define nh5set_tag_c                  FNAME(H5TSET_TAG_C)
-#   define nh5get_tag_c                  FNAME(H5TGET_TAG_C)
+#   define nh5tset_tag_c                  FNAME(H5TSET_TAG_C)
+#   define nh5tget_tag_c                  FNAME(H5TGET_TAG_C)
+#   define nh5tarray_create_c             FNAME(H5TARRAY_CREATE_C)
+#   define nh5tget_array_ndims_c          FNAME(H5TGET_ARRAY_NDIMS_C)
+#   define nh5tget_array_dims_c          FNAME(H5TGET_ARRAY_DIMS_C)
+#   define nh5tget_super_c               FNAME(H5TGET_SUPER_C)
+
 #else
 #   define nh5topen_c         FNAME(h5topen_c)
 #   define nh5tcommit_c       FNAME(h5tcommit_c)
@@ -475,6 +480,10 @@ extern int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
 #   define nh5tget_member_value_c             FNAME(h5tget_member_value_c)
 #   define nh5tset_tag_c                  FNAME(h5tset_tag_c)
 #   define nh5tget_tag_c                  FNAME(h5tget_tag_c)
+#   define nh5tarray_create_c             FNAME(h5tarray_create_c)
+#   define nh5tget_array_ndims_c          FNAME(h5tget_array_ndims_c)
+#   define nh5tget_array_dims_c          FNAME(h5tget_array_dims_c)
+#   define nh5tget_super_c               FNAME(h5tget_super_c)
 #endif
 #endif
 
@@ -548,6 +557,14 @@ extern int_f
 nh5tset_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen);
 extern int_f
 nh5tget_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen);
+extern int_f
+nh5tarray_create_c(hid_t_f * base_id, int_f *rank, hsize_t_f* dims, hid_t_f* type_id);
+extern int_f
+nh5tget_array_dims_c ( hid_t_f *type_id , hsize_t_f * dims);
+extern int_f
+nh5tget_array_ndims_c ( hid_t_f *type_id , int_f * ndims);
+extern int_f
+nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
 
 
 /*