diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Ff.c | 61 | ||||
| -rw-r--r-- | fortran/src/H5Fff.f90 | 119 | ||||
| -rw-r--r-- | fortran/src/H5Pf.c | 90 | ||||
| -rw-r--r-- | fortran/src/H5Pff.f90 | 179 | ||||
| -rw-r--r-- | fortran/src/H5Tf.c | 43 | ||||
| -rw-r--r-- | fortran/src/H5Tff.f90 | 59 | ||||
| -rw-r--r-- | fortran/src/H5_f.c | 9 | ||||
| -rw-r--r-- | fortran/src/H5f90global.f90 | 20 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 27 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.f90 | 9 | ||||
| -rw-r--r-- | fortran/test/tH5F.f90 | 126 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 9 |
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") |