summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Ff.c61
-rw-r--r--fortran/src/H5Fff.f90119
-rw-r--r--fortran/src/H5Pf.c90
-rw-r--r--fortran/src/H5Pff.f90179
-rw-r--r--fortran/src/H5Tf.c43
-rw-r--r--fortran/src/H5Tff.f9059
-rw-r--r--fortran/src/H5_f.c9
-rw-r--r--fortran/src/H5f90global.f9020
-rw-r--r--fortran/src/H5f90proto.h27
-rw-r--r--fortran/test/fortranlib_test.f909
-rw-r--r--fortran/test/tH5F.f90126
-rw-r--r--fortran/test/tH5T.f909
12 files changed, 741 insertions, 10 deletions
diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c
index df773c4..6de752d 100644
--- a/fortran/src/H5Ff.c
+++ b/fortran/src/H5Ff.c
@@ -360,7 +360,7 @@ nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2)
* Inputs: file_id - file identifier
* Outputs: prop_id - creation property list identifier
* Returns: 0 on success, -1 on failure
- * Programmer: Xiangyang Su
+ * Programmer: Elena Pourmal, Xiangyang Su
* Wednesday, November 3, 1999
* Modifications:
*---------------------------------------------------------------------------*/
@@ -370,7 +370,7 @@ nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id)
int ret_value = -1;
hid_t c_file_id, c_prop_id;
- c_file_id = *file_id;
+ c_file_id = (hid_t)*file_id;
c_prop_id = H5Fget_create_plist(c_file_id);
if (c_prop_id < 0) return ret_value;
@@ -386,8 +386,8 @@ nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id)
* Inputs: file_id - file identifier
* Outputs: access_id - access property list identifier
* Returns: 0 on success, -1 on failure
- * Programmer: Xiangyang Su
- * Friday, November 5, 1999
+ * Programmer: Elena Pourmal
+ * Monday, September 30, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
@@ -396,7 +396,7 @@ nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id)
int ret_value = -1;
hid_t c_file_id, c_access_id;
- c_file_id = *file_id;
+ c_file_id = (hid_t)*file_id;
c_access_id = H5Fget_access_plist(c_file_id);
if (c_access_id < 0) return ret_value;
@@ -463,3 +463,54 @@ nh5fclose_c ( hid_t_f *file_id )
if ( H5Fclose(c_file_id) < 0 ) ret_value = -1;
return ret_value;
}
+/*----------------------------------------------------------------------------
+ * Name: h5fget_obj_count_c
+ * Purpose: Call H5Fget_obj_count to get number of open objects within a file
+ * Inputs: file_id - identifier of the file to be closed
+ * obj_type - type of the object
+ * Returns: obj_count - number of objects
+ * 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Monday, September 30, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5fget_obj_count_c ( hid_t_f *file_id , int_f *obj_type, int_f * obj_count)
+{
+ int ret_value = 0;
+ hid_t c_file_id;
+ unsigned c_obj_type;
+ unsigned c_obj_count;
+
+
+ c_file_id = (hid_t)*file_id;
+ c_obj_type = (unsigned) *obj_type;
+ if ( H5Fget_obj_count(c_file_id, c_obj_type, &c_obj_count) < 0 ) ret_value = -1;
+ *obj_count = (int_f)c_obj_count;
+ return ret_value;
+}
+/*----------------------------------------------------------------------------
+ * Name: h5fget_obj_ids_c
+ * Purpose: Call H5Fget_obj_count to get number of open objects within a file
+ * Inputs: file_id - identifier of the file to be closed
+ * obj_type - type of the object
+ * Returns: obj_ids - iarray of open objects identifiers
+ * 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Monday, September 30, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5fget_obj_ids_c ( hid_t_f *file_id , int_f *obj_type, hid_t_f *obj_ids)
+{
+ int ret_value = 0;
+ hid_t c_file_id;
+ unsigned c_obj_type;
+
+ c_file_id = (hid_t)*file_id;
+ c_obj_type = (unsigned) *obj_type;
+ if ( H5Fget_obj_ids(c_file_id, c_obj_type, (hid_t *)obj_ids) < 0 ) ret_value = -1;
+ return ret_value;
+}
diff --git a/fortran/src/H5Fff.f90 b/fortran/src/H5Fff.f90
index 6e0cb3a..7b995a5 100644
--- a/fortran/src/H5Fff.f90
+++ b/fortran/src/H5Fff.f90
@@ -102,7 +102,6 @@
! H5F_SCOPE_GLOBAL_F
! H5F_SCOPE_LOCAL_F
! Outputs:
-! file_id - file identifier
! hdferr: - error code
! Success: 0
! Failure: -1
@@ -669,4 +668,122 @@
END SUBROUTINE h5fclose_f
+!----------------------------------------------------------------------
+! Name: h5fget_obj_count_f
+!
+! Purpose: Gets number of the objects open within a file
+!
+! Inputs:
+! file_id - file identifier
+! obj_type - type of the object; possible values are:
+! H5F_OBJ_FILE_F
+! H5F_OBJ_DATASET_F
+! H5F_OBJ_GROUP_F
+! H5F_OBJ_DATATYPE_F
+! H5F_OBJ_ALL_F
+! Outputs:
+! obj_count - number of open objects
+! hdferr: - error code
+! Success: 0
+! Failure: -1
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 30, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5fget_obj_count_f(file_id, obj_type, obj_count, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5fget_obj_count_f
+!DEC$endif
+!
+
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
+ INTEGER, INTENT(IN) :: obj_type ! Object type
+ INTEGER, INTENT(OUT) :: obj_count ! Number of open objects
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+
+ INTERFACE
+ INTEGER FUNCTION h5fget_obj_count_c(file_id, obj_type, obj_count)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5FGET_OBJ_COUNT_C':: h5fget_obj_count_c
+ !DEC$ ENDIF
+ INTEGER(HID_T), INTENT(IN) :: file_id
+ INTEGER, INTENT(IN) :: obj_type ! Object type
+ INTEGER, INTENT(OUT) :: obj_count ! Number of open objects
+ END FUNCTION h5fget_obj_count_c
+ END INTERFACE
+
+ hdferr = h5fget_obj_count_c(file_id, obj_type, obj_count)
+
+ END SUBROUTINE h5fget_obj_count_f
+
+!----------------------------------------------------------------------
+! Name: h5fget_obj_ids_f
+!
+! Purpose: Get list of open objects identifiers within a file
+!
+! Inputs:
+! file_id - file identifier
+! obj_type - type of the object; possible values are:
+! H5F_OBJ_FILE_F
+! H5F_OBJ_DATASET_F
+! H5F_OBJ_GROUP_F
+! H5F_OBJ_DATATYPE_F
+! H5F_OBJ_ALL_F
+! Outputs:
+! obj_ids - array of open object identifiers
+! hdferr: - error code
+! Success: 0
+! Failure: -1
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 30, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5fget_obj_ids_f(file_id, obj_type, obj_ids, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5fget_obj_ids_f
+!DEC$endif
+!
+
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
+ INTEGER, INTENT(IN) :: obj_type ! Object type
+ INTEGER(HID_T), DIMENSION(*), INTENT(INOUT) :: obj_ids
+ ! Array of open objects iidentifiers
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+
+ INTERFACE
+ INTEGER FUNCTION h5fget_obj_ids_c(file_id, obj_type, obj_ids)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5FGET_OBJ_IDS_C':: h5fget_obj_ids_c
+ !DEC$ ENDIF
+ INTEGER(HID_T), INTENT(IN) :: file_id
+ INTEGER, INTENT(IN) :: obj_type
+ INTEGER(HID_T), DIMENSION(*), INTENT(INOUT) :: obj_ids
+ END FUNCTION h5fget_obj_ids_c
+ END INTERFACE
+
+ hdferr = h5fget_obj_ids_c(file_id, obj_type, obj_ids)
+
+ END SUBROUTINE h5fget_obj_ids_f
END MODULE H5F
diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c
index 51b9b71..438b07d 100644
--- a/fortran/src/H5Pf.c
+++ b/fortran/src/H5Pf.c
@@ -97,12 +97,40 @@ nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id)
hid_t c_new_prp_id;
c_prp_id = *prp_id;
- c_new_prp_id = H5Tcopy(c_prp_id);
+ c_new_prp_id = H5Pcopy(c_prp_id);
if ( c_new_prp_id < 0 ) ret_value = -1;
*new_prp_id = (hid_t_f)c_new_prp_id;
return ret_value;
}
+/*----------------------------------------------------------------------------
+ * Name: h5pequal_c
+ * Purpose: Call H5Pequal to check if two property lists are equal
+ * Inputs: plist1_id - property list identifier
+ * plist2_id - property list identifier
+ * Outputs: c_flag - flag to indicate that lists are eqaul
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Monday, September 30, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f * c_flag)
+{
+ int ret_value = 0;
+ hid_t c_plist1_id;
+ hid_t c_plist2_id;
+ htri_t c_c_flag;
+
+ c_plist1_id = (hid_t)*plist1_id;
+ c_plist2_id = (hid_t)*plist2_id;
+ c_c_flag = H5Pequal(c_plist1_id, c_plist2_id);
+ if ( c_c_flag < 0 ) ret_value = -1;
+ *c_flag = (int_f)c_c_flag;
+ return ret_value;
+}
+
/*----------------------------------------------------------------------------
* Name: h5pget_class_c
@@ -1798,3 +1826,63 @@ nh5pget_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* ri
ret_value = 0;
return ret_value;
}
+/*----------------------------------------------------------------------------
+ * Name: h5pget_fclose_degree_c
+ * Purpose: Call H5Pget_fclose_degree to determine file close behavior
+ * Inputs: fapl_id - file access identifier
+ * Outputs:
+ * degree - possible values are:
+ * H5F_CLOSE_DEFAULT
+ * H5F_CLOSE_WEAK
+ * H5F_CLOSE_SEMI
+ * H5F_CLOSE_STRONG
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Thursday, September 26, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5pget_fclose_degree_c ( hid_t_f *fapl_id , int_f *degree)
+{
+ int ret_value = -1;
+ hid_t c_fapl_id;
+ H5F_close_degree_t c_degree;
+
+ c_fapl_id = (hid_t)*fapl_id;
+ if( H5Pget_fclose_degree(c_fapl_id, &c_degree) < 0) return ret_value;
+
+ *degree = (int_f)c_degree;
+ ret_value = 0;
+ return ret_value;
+}
+
+/*----------------------------------------------------------------------------
+ * Name: h5pset_fclose_degree_c
+ * Purpose: Call H5Pset_fclose_degree to set file close behavior
+ * Inputs: fapl_id - file access identifier
+ * degree - possible values are:
+ * H5F_CLOSE_DEFAULT
+ * H5F_CLOSE_WEAK
+ * H5F_CLOSE_SEMI
+ * H5F_CLOSE_STRONG
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Thursday, September 26, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+
+int_f
+nh5pset_fclose_degree_c ( hid_t_f *fapl_id , int_f *degree)
+{
+ int ret_value = -1;
+ hid_t c_fapl_id;
+ hid_t c_degree;
+
+ c_fapl_id = (hid_t)*fapl_id;
+ c_degree = (H5F_close_degree_t)*degree;
+ if( H5Pset_fclose_degree(c_fapl_id, c_degree) < 0) return ret_value;
+
+ ret_value = 0;
+ return ret_value;
+}
diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90
index 9d5ee4e..b2eed09 100644
--- a/fortran/src/H5Pff.f90
+++ b/fortran/src/H5Pff.f90
@@ -3148,4 +3148,183 @@
hdferr = h5pget_btree_ratios_c(prp_id, left, middle, right)
END SUBROUTINE h5pget_btree_ratios_f
+!----------------------------------------------------------------------
+! Name: h5pget_fclose_degree_f
+!
+! Purpose: Returns the degree for the file close behavior.
+!
+! Inputs:
+! fapl_id - file access property list identifier
+! Outputs:
+! degree - one of the following:
+! Possible values are:
+! H5F_CLOSE_DEFAULT_F
+! H5F_CLOSE_WEAK_F
+! H5F_CLOSE_SEMI_F
+! H5F_CLOSE_STRONG_F
+! hdferr: - error code
+! Success: 0
+! Failure: -1
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 26, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5pget_fclose_degree_f
+!DEC$endif
+!
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier
+ INTEGER, INTENT(OUT) :: degree ! Possible values
+ ! are:
+ ! H5F_CLOSE_DEFAULT_F
+ ! H5F_CLOSE_WEAK_F
+ ! H5F_CLOSE_SEMI_F
+ ! H5F_CLOSE_STRONG_F
+
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+
+! INTEGER, EXTERNAL :: h5pget_fclose_degree_c
+! MS FORTRAN needs explicit interface for C functions called here.
+!
+ INTERFACE
+ INTEGER FUNCTION h5pget_fclose_degree_c(fapl_id, degree)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5PGET_FCLOSE_DEGREE_C'::h5pget_fclose_degree_c
+ !DEC$ ENDIF
+ INTEGER(HID_T), INTENT(IN) :: fapl_id
+ INTEGER, INTENT(OUT) :: degree
+ END FUNCTION h5pget_fclose_degree_c
+ END INTERFACE
+
+ hdferr = h5pget_fclose_degree_c(fapl_id, degree)
+ END SUBROUTINE h5pget_fclose_degree_f
+
+!----------------------------------------------------------------------
+! Name: h5pset_fclose_degree_f
+!
+! Purpose: Sets the degree for the file close behavior.
+!
+! Inputs:
+! fapl_id - file access property list identifier
+! degree - one of the following:
+! Possible values are:
+! H5F_CLOSE_DEFAULT_F
+! H5F_CLOSE_WEAK_F
+! H5F_CLOSE_SEMI_F
+! H5F_CLOSE_STRONG_F
+! Outputs:
+! hdferr: - error code
+! Success: 0
+! Failure: -1
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 26, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5pset_fclose_degree_f
+!DEC$endif
+!
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier
+ INTEGER, INTENT(IN) :: degree ! Possible values
+ ! are:
+ ! H5F_CLOSE_DEFAULT_F
+ ! H5F_CLOSE_WEAK_F
+ ! H5F_CLOSE_SEMI_F
+ ! H5F_CLOSE_STRONG_F
+
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+
+ INTERFACE
+ INTEGER FUNCTION h5pset_fclose_degree_c(fapl_id, degree)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5PSET_FCLOSE_DEGREE_C'::h5pset_fclose_degree_c
+ !DEC$ ENDIF
+ INTEGER(HID_T), INTENT(IN) :: fapl_id
+ INTEGER, INTENT(IN) :: degree
+ END FUNCTION h5pset_fclose_degree_c
+ END INTERFACE
+
+ hdferr = h5pset_fclose_degree_c(fapl_id, degree)
+ END SUBROUTINE h5pset_fclose_degree_f
+
+!----------------------------------------------------------------------
+! Name: h5pequal_f
+!
+! Purpose: Checks if two property lists are eqaul
+!
+! Inputs:
+! plist1_id - property list identifier
+! plist2_id - property list identifier
+! Outputs:
+! flag - flag, possible values
+! .TRUE. or .FALSE.
+! hdferr: - error code
+! Success: 0
+! Failure: -1, flag is set to .FALSE.
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 30, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5pequal_f
+!DEC$endif
+!
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier
+ INTEGER(HID_T), INTENT(IN) :: plist2_id ! Property list identifier
+ LOGICAL, INTENT(OUT) :: flag ! Flag
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER :: c_flag
+
+ INTERFACE
+ INTEGER FUNCTION h5pequal_c(plist1_id, plist2_id, c_flag)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5PEQUAL_C'::h5pequal_c
+ !DEC$ ENDIF
+ INTEGER(HID_T), INTENT(IN) :: plist1_id
+ INTEGER(HID_T), INTENT(IN) :: plist2_id
+ INTEGER, INTENT(OUT) :: c_flag
+ END FUNCTION h5pequal_c
+ END INTERFACE
+
+ flag = .FALSE.
+ hdferr = h5pequal_c(plist1_id, plist2_id, c_flag)
+ if (c_flag .GT. 0) flag = .TRUE.
+ END SUBROUTINE h5pequal_f
+
END MODULE H5P
diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c
index 332a9cd..789649f 100644
--- a/fortran/src/H5Tf.c
+++ b/fortran/src/H5Tf.c
@@ -987,6 +987,49 @@ nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member_name, int_f
ret_value = 0;
return ret_value;
}
+/*----------------------------------------------------------------------------
+ * Name: h5tget_member_index_c
+ * Purpose: Call H5Tget_member_index to get an index of
+ * the specified datatype filed or member.
+ * Inputs: type_id - datatype identifier
+ * name - name of the datatype within file or group
+ * namelen - name length
+ * Outputs: index - 0-based index
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Thursday, September 26, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+int_f
+nh5tget_member_index_c (hid_t_f *type_id, _fcd name, int_f *namelen, int_f *index)
+{
+ int ret_value = -1;
+ char *c_name;
+ int c_namelen;
+ hid_t c_type_id;
+ int c_index;
+
+ /*
+ * Convert FORTRAN name to C name
+ */
+ c_namelen = *namelen;
+ c_name = (char *)HD5f2cstring(name, c_namelen);
+ if (c_name == NULL) return ret_value;
+
+ /*
+ * Call H5Tget_member_index function.
+ */
+ c_type_id = (hid_t)*type_id;
+ c_index = H5Tget_member_index(c_type_id, c_name);
+
+ if (c_index < 0) goto DONE;
+ *index = (int_f)c_index;
+DONE:
+ HDfree(c_name);
+ ret_value = 0;
+ return ret_value;
+}
+
/*----------------------------------------------------------------------------
* Name: h5tget_member_offset_c
diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90
index 6cfc525..61319e0 100644
--- a/fortran/src/H5Tff.f90
+++ b/fortran/src/H5Tff.f90
@@ -1912,7 +1912,7 @@
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5tget_member_name_f(type_id,index, member_name, namelen, hdferr)
+ SUBROUTINE h5tget_member_name_f(type_id, index, member_name, namelen, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
@@ -2004,6 +2004,63 @@
hdferr = h5tget_member_offset_c(type_id, member_no, offset )
END SUBROUTINE h5tget_member_offset_f
+!----------------------------------------------------------------------
+! Name: h5tget_member_index_f
+!
+! Purpose: Retrieves the index of a compound or enumeration datatype member.
+!
+! Inputs:
+! type_id - datatype identifier
+! name - name of the field or member whose index to
+! to be retrieved from the datatype.
+! Outputs:
+! index - 0-based index of the filed or member (0 to N-1)
+! hdferr: - error code
+! Success: 0
+! Failure: -1
+! Optional parameters:
+! NONE
+!
+! Programmer: Elena Pourmal
+! September 26, 2002
+!
+! Modifications:
+!
+! Comment:
+!----------------------------------------------------------------------
+
+ SUBROUTINE h5tget_member_index_f(type_id, name, index, hdferr)
+!
+!This definition is needed for Windows DLLs
+!DEC$if defined(BUILD_HDF5_DLL)
+!DEC$attributes dllexport :: h5tget_member_index_f
+!DEC$endif
+!
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier
+ CHARACTER(LEN=*), INTENT(IN) :: name ! Field or member name
+ INTEGER, INTENT(OUT) :: index ! Field or member index
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER :: namelen ! Name length
+
+ INTERFACE
+ INTEGER FUNCTION h5tget_member_index_c(type_id, name, namelen, index)
+ USE H5GLOBAL
+ !DEC$ IF DEFINED(HDF5F90_WINDOWS)
+ !MS$ATTRIBUTES C,reference,alias:'_H5TGET_MEMBER_INDEX_C'::h5tget_member_index_c
+ !DEC$ ENDIF
+ !DEC$ATTRIBUTES reference ::name
+ INTEGER(HID_T), INTENT(IN) :: type_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER, INTENT(IN) :: namelen
+ INTEGER, INTENT(OUT) :: index
+ END FUNCTION h5tget_member_index_c
+ END INTERFACE
+
+ namelen = LEN(name)
+ hdferr = h5tget_member_index_c(type_id, name, namelen, index)
+ END SUBROUTINE h5tget_member_index_f
+
!----------------------------------------------------------------------
! Name: h5tget_member_dim_f
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index d8b3d06..93d7331 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -209,6 +209,15 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, int_f *h5f_flags,
h5f_flags[4] = (int_f)H5F_ACC_DEBUG;
h5f_flags[5] = (int_f)H5F_SCOPE_LOCAL;
h5f_flags[6] = (int_f)H5F_SCOPE_GLOBAL;
+ h5f_flags[7] = (int_f)H5F_CLOSE_DEFAULT;
+ h5f_flags[8] = (int_f)H5F_CLOSE_WEAK;
+ h5f_flags[9] = (int_f)H5F_CLOSE_SEMI;
+ h5f_flags[10] = (int_f)H5F_CLOSE_STRONG;
+ h5f_flags[11] = (int_f)H5F_OBJ_FILE;
+ h5f_flags[12] = (int_f)H5F_OBJ_DATASET;
+ h5f_flags[13] = (int_f)H5F_OBJ_GROUP;
+ h5f_flags[14] = (int_f)H5F_OBJ_DATATYPE;
+ h5f_flags[15] = (int_f)H5F_OBJ_ALL;
/*
* H5FD flags
diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90
index 9a2ce67..2295ae8 100644
--- a/fortran/src/H5f90global.f90
+++ b/fortran/src/H5f90global.f90
@@ -135,7 +135,7 @@
!
! H5F flags declaration
!
- INTEGER, PARAMETER :: H5F_FLAGS_LEN = 7
+ INTEGER, PARAMETER :: H5F_FLAGS_LEN = 16
INTEGER H5F_flags(H5F_FLAGS_LEN)
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: /H5F_FLAGS/
@@ -149,6 +149,15 @@
INTEGER :: H5F_ACC_DEBUG_F
INTEGER :: H5F_SCOPE_LOCAL_F
INTEGER :: H5F_SCOPE_GLOBAL_F
+ INTEGER :: H5F_CLOSE_DEFAULT_F
+ INTEGER :: H5F_CLOSE_WEAK_F
+ INTEGER :: H5F_CLOSE_SEMI_F
+ INTEGER :: H5F_CLOSE_STRONG_F
+ INTEGER :: H5F_OBJ_FILE_F
+ INTEGER :: H5F_OBJ_DATASET_F
+ INTEGER :: H5F_OBJ_GROUP_F
+ INTEGER :: H5F_OBJ_DATATYPE_F
+ INTEGER :: H5F_OBJ_ALL_F
EQUIVALENCE(H5F_flags(1), H5F_ACC_RDWR_F)
EQUIVALENCE(H5F_flags(2), H5F_ACC_RDONLY_F)
@@ -157,6 +166,15 @@
EQUIVALENCE(H5F_flags(5), H5F_ACC_DEBUG_F)
EQUIVALENCE(H5F_flags(6), H5F_SCOPE_LOCAL_F)
EQUIVALENCE(H5F_flags(7), H5F_SCOPE_GLOBAL_F)
+ EQUIVALENCE(H5F_flags(8), H5F_CLOSE_DEFAULT_F)
+ EQUIVALENCE(H5F_flags(9), H5F_CLOSE_WEAK_F)
+ EQUIVALENCE(H5F_flags(10), H5F_CLOSE_SEMI_F)
+ EQUIVALENCE(H5F_flags(11), H5F_CLOSE_STRONG_F)
+ EQUIVALENCE(H5F_flags(12), H5F_OBJ_FILE_F)
+ EQUIVALENCE(H5F_flags(13), H5F_OBJ_DATASET_F)
+ EQUIVALENCE(H5F_flags(14), H5F_OBJ_GROUP_F)
+ EQUIVALENCE(H5F_flags(15), H5F_OBJ_DATATYPE_F)
+ EQUIVALENCE(H5F_flags(16), H5F_OBJ_ALL_F)
!
! H5G flags declaration
!
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 3cc86df..b87f898 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -22,6 +22,8 @@ H5_DLL int HD5packFstring(char *src, char *dest, int len);
# define nh5freopen_c FNAME(H5FREOPEN_C)
# define nh5fget_create_plist_c FNAME(H5FGET_CREATE_PLIST_C)
# define nh5fget_access_plist_c FNAME(H5FGET_ACCESS_PLIST_C)
+# define nh5fget_obj_count_c FNAME(H5FGET_OBJ_COUNT_C)
+# define nh5fget_obj_ids_c FNAME(H5FGET_OBJ_IDS_C)
#else /* !DF_CAPFNAMES */
# define nh5fcreate_c FNAME(h5fcreate_c)
# define nh5fflush_c FNAME(h5fflush_c)
@@ -33,6 +35,8 @@ H5_DLL int HD5packFstring(char *src, char *dest, int len);
# define nh5freopen_c FNAME(h5freopen_c)
# define nh5fget_create_plist_c FNAME(h5fget_create_plist_c)
# define nh5fget_access_plist_c FNAME(h5fget_access_plist_c)
+# define nh5fget_obj_count_c FNAME(h5fget_obj_count_c)
+# define nh5fget_obj_ids_c FNAME(h5fget_obj_ids_c)
#endif /* DF_CAPFNAMES */
#endif /* H5Ff90_FNAMES */
@@ -51,8 +55,15 @@ H5_DLL int_f nh5fmount_c
H5_DLL int_f nh5funmount_c
(hid_t_f *loc_id, _fcd dsetname, int_f *namelen);
H5_DLL int_f nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2);
+
H5_DLL int_f nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id);
+
H5_DLL int_f nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id);
+
+H5_DLL int_f nh5fget_obj_count_c (hid_t_f *file_id, int_f *obj_type, int_f *obj_count);
+
+H5_DLL int_f nh5fget_obj_ids_c (hid_t_f *file_id, int_f *obj_type, int_f *obj_ids);
+
/*
* Functions from H5Sf.c
*/
@@ -424,6 +435,7 @@ H5_DLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
# define nh5tget_member_offset_c FNAME(H5TGET_MEMBER_OFFSET_C)
# define nh5tget_member_dims_c FNAME(H5TGET_MEMBER_DIMS_C)
# define nh5tget_member_type_c FNAME(H5TGET_MEMBER_TYPE_C)
+# define nh5tget_member_index_c FNAME(H5TGET_MEMBER_INDEX_C)
# define nh5tinsert_c FNAME(H5TINSERT_C)
# define nh5tcreate_c FNAME(H5TCREATE_C)
# define nh5tpack_c FNAME(H5TPACK_C)
@@ -478,6 +490,7 @@ H5_DLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
# define nh5tget_member_offset_c FNAME(h5tget_member_offset_c)
# define nh5tget_member_dims_c FNAME(h5tget_member_dims_c)
# define nh5tget_member_type_c FNAME(h5tget_member_type_c)
+# define nh5tget_member_index_c FNAME(h5tget_member_index_c)
# define nh5tinsert_c FNAME(h5tinsert_c)
# define nh5tcreate_c FNAME(h5tcreate_c)
# define nh5tpack_c FNAME(h5tpack_c)
@@ -547,6 +560,8 @@ H5_DLL int_f nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member
H5_DLL int_f nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t_f * field_dims, int_f * perm );
H5_DLL int_f nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f* offset);
H5_DLL int_f nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype);
+H5_DLL int_f nh5tget_member_index_c ( hid_t_f *type_id ,_fcd name, int_f* namelen, int_f *index);
+
H5_DLL int_f nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_t_f * field_id);
H5_DLL int_f nh5tpack_c(hid_t_f * type_id);
@@ -587,6 +602,7 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pcreate_c FNAME(H5PCREATE_C)
# define nh5pclose_c FNAME(H5PCLOSE_C)
# define nh5pcopy_c FNAME(H5PCOPY_C)
+# define nh5pequal_c FNAME(H5PEQUAL_C)
# define nh5pget_class_c FNAME(H5PGET_CLASS_C)
# define nh5pset_deflate_c FNAME(H5PSET_DEFLATE_C)
# define nh5pset_preserve_c FNAME(H5PSET_PRESERVE_C)
@@ -639,11 +655,14 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pget_fapl_mpio_c FNAME(H5PGET_FAPL_MPIO_C)
# define nh5pset_dxpl_mpio_c FNAME(H5PSET_DXPL_MPIO_C)
# define nh5pget_dxpl_mpio_c FNAME(H5PGET_DXPL_MPIO_C)
+# define nh5pget_fclose_degree_c FNAME(H5PGET_FCLOSE_DEGREE_C)
+# define nh5pset_fclose_degree_c FNAME(H5PSET_FCLOSE_DEGREE_C)
#else
# define nh5pcreate_c FNAME(h5pcreate_c)
# define nh5pclose_c FNAME(h5pclose_c)
# define nh5pcopy_c FNAME(h5pcopy_c)
+# define nh5pequal_c FNAME(h5pequal_c)
# define nh5pget_class_c FNAME(h5pget_class_c)
# define nh5pset_deflate_c FNAME(h5pset_deflate_c)
# define nh5pset_preserve_c FNAME(h5pset_preserve_c)
@@ -696,6 +715,9 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pget_fapl_mpio_c FNAME(h5pget_fapl_mpio_c)
# define nh5pset_dxpl_mpio_c FNAME(h5pset_dxpl_mpio_c)
# define nh5pget_dxpl_mpio_c FNAME(h5pget_dxpl_mpio_c)
+# define nh5pget_fclose_degree_c FNAME(h5pget_fclose_degree_c)
+# define nh5pset_fclose_degree_c FNAME(h5pset_fclose_degree_c)
+
#endif
#endif
@@ -706,6 +728,8 @@ H5_DLL int_f nh5pclose_c ( hid_t_f *prp_id );
H5_DLL int_f nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id);
+H5_DLL int_f nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f *c_flag);
+
H5_DLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype);
H5_DLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level);
@@ -815,7 +839,8 @@ H5_DLL int_f
nh5pget_dxpl_mpio_rc(hid_t_f *prp_id, int_f* data_xfer_mode);
H5_DLL int_f
nh5pset_dxpl_mpio_c(hid_t_f *prp_id, int_f* data_xfer_mode);
-
+H5_DLL int_f nh5pset_fclose_degree_c(hid_t_f *fapl, int_f *degree);
+H5_DLL int_f nh5pget_fclose_degree_c(hid_t_f *fapl, int_f *degree);
/*
* Functions frome H5Rf.c
*/
diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90
index a8d9565..41398b7 100644
--- a/fortran/test/fortranlib_test.f90
+++ b/fortran/test/fortranlib_test.f90
@@ -26,6 +26,7 @@
INTEGER :: error
INTEGER :: mounting_total_error = 0
INTEGER :: reopen_total_error = 0
+ INTEGER :: fclose_total_error = 0
INTEGER :: dataset_total_error = 0
INTEGER :: extend_dataset_total_error = 0
INTEGER :: refobj_total_error = 0
@@ -89,6 +90,14 @@
write(*, fmt = e_format) error_string
total_error = total_error + reopen_total_error
+ error_string = failure
+ CALL file_close(cleanup, fclose_total_error)
+ IF (fclose_total_error == 0) error_string = success
+ write(*, fmt = '(21a)', advance = 'no') ' File open/close test'
+ write(*, fmt = '(49x,a)', advance = 'no') ' '
+ write(*, fmt = e_format) error_string
+ total_error = total_error + fclose_total_error
+
! write(*,*)
! write(*,*) '========================================='
diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90
index 0f058d9..6aa796d 100644
--- a/fortran/test/tH5F.f90
+++ b/fortran/test/tH5F.f90
@@ -543,6 +543,132 @@
END SUBROUTINE plisttest
+!
+! The following subroutine tests h5pget(set)_fclose_degree_f
+!
+
+ SUBROUTINE file_close(cleanup, total_error)
+ USE HDF5 ! This module contains all necessary modules
+ IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
+ INTEGER, INTENT(OUT) :: total_error
+ INTEGER :: error
+
+ !
+ CHARACTER(LEN=10), PARAMETER :: filename = "file_close"
+ CHARACTER(LEN=80) :: fix_filename
+
+ INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers
+ INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers
+ INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers
+ LOGICAL :: flag
+ INTEGER :: obj_count, obj_countf
+ INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids
+ INTEGER :: i
+
+ CALL h5eset_auto_f(0, error)
+
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify filename"
+ stop
+ endif
+ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error)
+ CALL check("h5fcreate_f",error,total_error)
+
+ CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
+ CALL check("h5pcreate_f",error,total_error)
+ CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error)
+ CALL check("h5pset_fclose_degree_f",error,total_error)
+
+
+ CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error)
+ CALL check("h5pcreate_f",error,total_error)
+ CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error)
+ CALL check("h5pset_fclose_degree_f",error,total_error)
+
+
+ CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error)
+ CALL check("h5pcreate_f",error,total_error)
+ CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error)
+ CALL check("h5pset_fclose_degree_f",error,total_error)
+
+ CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error)
+ CALL check("h5pcreate_f",error,total_error)
+ CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error)
+ CALL check("h5pset_fclose_degree_f",error,total_error)
+
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1)
+ CALL check("h5fopen_f",error,total_error)
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl)
+ CALL check("h5fopen_f",error,total_error)
+ CALL h5fget_access_plist_f(fid1, fid1_fapl, error)
+ CALL check("h5fget_access_plist_f",error,total_error)
+ CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error)
+ CALL check("h5fget_access_plist_f",error,total_error)
+
+ CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error)
+ CALL check("h5pequal_f",error,total_error)
+ if (.NOT. flag) then
+ write(*,*) " File access lists should be equal, error "
+ total_error=total_error + 1
+ endif
+
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2)
+ if( error .ne. -1) then
+ total_error = total_error + 1
+ write(*,*) " Open with H5F_CLOSE_SEMI should fail "
+ endif
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3)
+ if( error .ne. -1) then
+ total_error = total_error + 1
+ write(*,*) " Open with H5F_CLOSE_STRONG should fail "
+ endif
+
+ CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error)
+ CALL check("h5fget_obj_count_f",error,total_error)
+ if(error .eq.0 .and. obj_count .ne. 3) then
+ total_error = total_error + 1
+ write(*,*) "Wrong number of open objects reported, error"
+ endif
+ CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error)
+ CALL check("h5fget_obj_count_f",error,total_error)
+ if(error .eq.0 .and. obj_countf .ne. 3) then
+ total_error = total_error + 1
+ write(*,*) "Wrong number of open objects reported, error"
+ endif
+ allocate(obj_ids(obj_countf), stat = error)
+ CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_ids, error)
+ CALL check("h5fget_obj_ids_f",error,total_error)
+ if(error .eq. 0) then
+ do i = 1, obj_countf
+ CALL h5fclose_f(obj_ids(i), error)
+ CALL check("h5fclose_f",error,total_error)
+ enddo
+ endif
+
+ CALL h5fclose_f(fid, error)
+ if(error .eq. 0) then
+ total_error = total_error + 1
+ write(*,*) "File should be closed at this point, error"
+ endif
+ CALL h5fclose_f(fid1, error)
+ if(error .eq. 0) then
+ total_error = total_error + 1
+ write(*,*) "File should be closed at this point, error"
+ endif
+ CALL h5fclose_f(fid_d, error)
+ if(error .eq. 0) then
+ total_error = total_error + 1
+ write(*,*) "File should be closed at this point, error"
+ endif
+
+ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
+ deallocate(obj_ids)
+ RETURN
+
+ END SUBROUTINE file_close
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index d546cd0..d7669af 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -81,6 +81,7 @@
INTEGER :: num_members ! Number of members in the compound datatype
CHARACTER(LEN=256) :: member_name
INTEGER :: len ! Lenght of the name of the compound datatype member
+ INTEGER :: member_index ! index of the field
LOGICAL :: flag
INTEGER(HSIZE_T), DIMENSION(3) :: array_dims=(/2,3,4/)
INTEGER :: array_dims_range = 3
@@ -305,12 +306,20 @@
endif
!
! Go through the members and find out their names and offsets.
+ ! Also see if name corresponds to the index
!
do i = 1, num_members
CALL h5tget_member_name_f(dtype_id, i-1, member_name, len, error)
CALL check("h5tget_member_name_f", error, total_error)
CALL h5tget_member_offset_f(dtype_id, i-1, offset_out, error)
CALL check("h5tget_member_offset_f", error, total_error)
+ CALL h5tget_member_index_f(dtype_id, member_name(1:len), member_index, error)
+ CALL check("h5tget_member_index_f", error, total_error)
+ if(member_index .ne. i-1) then
+ write(*,*) "Index returned is incorrect"
+ write(*,*) member_index, i-1
+ total_error = total_error + 1
+ endif
CHECK_NAME: SELECT CASE (member_name(1:len))
CASE("char_field")