diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Gf.c | 110 | ||||
| -rw-r--r-- | fortran/src/H5Gff.f90 | 151 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 10 | ||||
| -rw-r--r-- | fortran/test/tH5G.f90 | 24 |
4 files changed, 289 insertions, 6 deletions
diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index e00fd0c..f98ab87 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -275,6 +275,64 @@ DONE: } /*---------------------------------------------------------------------------- + * Name: h5glink2_c + * Purpose: Call H5Glink2 to link the specified type + * Inputs: cur_loc_id - identifier of file or group + * cur_name - name of the existing object for hard link releative + * to cur_loc_id location, + * anything for the soft link + * current_namelen - current name lenghth + * link_type - link type + * new_loc_id - location identifier + * new_name - new name for the object releative to the new_loc_id + * location + * new_namelen - new_name lenghth + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, September 25, 2002 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5glink2_c(hid_t_f *cur_loc_id, _fcd cur_name, int_f *cur_namelen, int_f *link_type, hid_t_f *new_loc_id, _fcd new_name, int_f *new_namelen) +{ + int ret_value = -1; + hid_t c_cur_loc_id; + hid_t c_new_loc_id; + H5G_link_t c_link_type; + char *c_cur_name, *c_new_name; + int c_cur_namelen, c_new_namelen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_cur_namelen =*cur_namelen; + c_new_namelen =*new_namelen; + c_cur_name = (char *)HD5f2cstring(cur_name, c_cur_namelen); + c_new_name = (char *)HD5f2cstring(new_name, c_new_namelen); + if (c_cur_name == NULL) return ret_value; + if (c_new_name == NULL) { HDfree(c_cur_name); + return ret_value; + } + + /* + * Call H5Glink2 function + */ + c_cur_loc_id = *cur_loc_id; + c_new_loc_id = *new_loc_id; + c_link_type = (H5G_link_t)*link_type; + c_ret_value = H5Glink2(c_cur_loc_id, c_cur_name, c_link_type, c_new_loc_id, c_new_name); + + if(c_ret_value < 0) goto DONE; + ret_value = 0; + +DONE: + HDfree(c_cur_name); + HDfree(c_new_name); + return ret_value ; +} + +/*---------------------------------------------------------------------------- * Name: h5gunlink_c * Purpose: Call H5Gunlink to remove the specified name * Inputs: loc_id - identifier of file or group @@ -362,6 +420,58 @@ DONE: } /*---------------------------------------------------------------------------- + * Name: h5gmove2_c + * Purpose: Call H5Gmove2 to rename an object within an HDF5 file + * Inputs: src_loc_id - identifier of file or group + * src_name - name of the original object relative to src_loc_id + * src_namelen - original name lenghth + * dst_loc_id - new location identifier + * dst_name - new name for the object relative to dst_loc_id + * dst_namelen - new name lenghth + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, September 25, 2002 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5gmove2_c(hid_t_f *src_loc_id, _fcd src_name, int_f *src_namelen, hid_t_f *dst_loc_id, _fcd dst_name, int_f*dst_namelen) +{ + int ret_value = -1; + hid_t c_src_loc_id; + hid_t c_dst_loc_id; + char *c_src_name, *c_dst_name; + int c_src_namelen, c_dst_namelen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_src_namelen = *src_namelen; + c_dst_namelen = *dst_namelen; + c_src_name = (char *)HD5f2cstring(src_name, c_src_namelen); + if(c_src_name == NULL) return ret_value; + + c_dst_name = (char *)HD5f2cstring(dst_name, c_dst_namelen); + if(c_dst_name == NULL) { HDfree(c_src_name); + return ret_value; + } + /* + * Call H5Gmove2 function + */ + c_src_loc_id = (hid_t)*src_loc_id; + c_dst_loc_id = (hid_t)*dst_loc_id; + c_ret_value = H5Gmove2(c_src_loc_id, c_src_name, c_dst_loc_id, c_dst_name); + if(c_ret_value < 0) goto DONE; + + ret_value = 0; + +DONE: + HDfree(c_src_name); + HDfree(c_dst_name); + return ret_value ; +} + +/*---------------------------------------------------------------------------- * Name: h5gget_linkval_c * Purpose: Call H5Gget_linkval to return the name of object * Inputs: loc_id - identifier of file or group diff --git a/fortran/src/H5Gff.f90 b/fortran/src/H5Gff.f90 index 96bc374..87024e7 100644 --- a/fortran/src/H5Gff.f90 +++ b/fortran/src/H5Gff.f90 @@ -426,6 +426,88 @@ END SUBROUTINE h5glink_f !---------------------------------------------------------------------- +! Name: h5glink2_f +! +! Purpose: Creates a link of the specified type from new_name +! to current_name. current_name and new_name are interpreted +! releative to current and new location identifiers. +! +! Inputs: +! cur_loc_id - location identifier +! cur_name - name of the existing object if link is a +! hard link. Can be anything for the soft link. +! link_type - link type +! Possible values are: +! H5G_LINK_HARD_F (0) or +! H5G_LINK_SOFT_F (1) +! new_loc_id - new location identifier +! new_name - new name for the object +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: Elena Pourmal +! September 25, 2002 +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5glink2_f(cur_loc_id, cur_name, link_type, new_loc_id, & + new_name, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5glink_f +!DEC$endif +! + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: cur_loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: cur_name + ! Current name of an object + INTEGER, INTENT(IN) :: link_type ! link type + ! Possible values are: + ! H5G_LINK_HARD_F (0) or + ! H5G_LINK_SOFT_F (1) + + INTEGER(HID_T), INTENT(IN) :: new_loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: new_name ! New name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: cur_namelen ! Lenghth of the current_name string + INTEGER :: new_namelen ! Lenghth of the new_name string + + INTERFACE + INTEGER FUNCTION h5glink2_c(cur_loc_id, cur_name, cur_namelen, & + link_type, new_loc_id, & + new_name, new_namelen) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !MS$ATTRIBUTES C,reference,alias:'_H5GLINK2_C'::h5glink2_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: cur_name + !DEC$ATTRIBUTES reference :: new_name + INTEGER(HID_T), INTENT(IN) :: cur_loc_id + INTEGER(HID_T), INTENT(IN) :: new_loc_id + INTEGER, INTENT(IN) :: link_type + CHARACTER(LEN=*), INTENT(IN) :: cur_name + CHARACTER(LEN=*), INTENT(IN) :: new_name + INTEGER :: cur_namelen + INTEGER :: new_namelen + END FUNCTION h5glink2_c + END INTERFACE + + cur_namelen = LEN(cur_name) + new_namelen = LEN(new_name) + hdferr = h5glink2_c(cur_loc_id, cur_name, cur_namelen, link_type, & + new_loc_id, new_name, new_namelen) + END SUBROUTINE h5glink2_f + +!---------------------------------------------------------------------- ! Name: h5gunlink_f ! ! Purpose: Removes the specified name from the group graph and @@ -556,6 +638,75 @@ END SUBROUTINE h5gmove_f !---------------------------------------------------------------------- +! Name: h5gmove2_f +! +! Purpose: Renames an object within an HDF5 file. +! +! Inputs: +! src_loc_id - original location identifier +! src_name - object's name at specified original location +! dst_loc_id - original location identifier +! dst_name - object's new name +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: Elena Pourmal +! September 25, 2002 +! +! Comment: +!---------------------------------------------------------------------- + + + SUBROUTINE h5gmove2_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gmove2_f +!DEC$endif +! + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: src_loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: src_name ! Original name of an object + INTEGER(HID_T), INTENT(IN) :: dst_loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: dst_name ! New name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: src_namelen ! Length of the current_name string + INTEGER :: dst_namelen ! Lenghth of the new_name string + +! INTEGER, EXTERNAL :: h5gmove2_c +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5gmove2_c(src_loc_id, src_name, src_namelen, & + dst_loc_id, dst_name, dst_namelen) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !MS$ATTRIBUTES C,reference,alias:'_H5GMOVE2_C'::h5gmove2_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: src_name + !DEC$ATTRIBUTES reference :: dst_name + INTEGER(HID_T), INTENT(IN) :: src_loc_id + INTEGER(HID_T), INTENT(IN) :: dst_loc_id + CHARACTER(LEN=*), INTENT(IN) :: src_name + CHARACTER(LEN=*), INTENT(IN) :: dst_name + INTEGER :: src_namelen + INTEGER :: dst_namelen + END FUNCTION h5gmove2_c + END INTERFACE + + src_namelen = LEN(src_name) + dst_namelen = LEN(dst_name) + hdferr = h5gmove2_c(src_loc_id, src_name, src_namelen,& + dst_loc_id, dst_name, dst_namelen) + END SUBROUTINE h5gmove2_f + +!---------------------------------------------------------------------- ! Name: h5gget_linkval_f ! ! Purpose: Returns the name of the object that the symbolic link diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index e12c421..3cc86df 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -255,8 +255,10 @@ H5_DLL int_f nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims); # define nh5gget_obj_info_idx_c FNAME(H5GGET_OBJ_INFO_IDX_C) # define nh5gn_members_c FNAME(H5GN_MEMBERS_C) # define nh5glink_c FNAME(H5GLINK_C) +# define nh5glink2_c FNAME(H5GLINK2_C) # define nh5gunlink_c FNAME(H5GUNLINK_C) # define nh5gmove_c FNAME(H5GMOVE_C) +# define nh5gmove2_c FNAME(H5GMOVE2_C) # define nh5gget_linkval_c FNAME(H5GGET_LINKVAL_C) # define nh5gset_comment_c FNAME(H5GSET_COMMENT_C) # define nh5gget_comment_c FNAME(H5GGET_COMMENT_C) @@ -267,8 +269,10 @@ H5_DLL int_f nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims); # define nh5gget_obj_info_idx_c FNAME(h5gget_obj_info_idx_c) # define nh5gn_members_c FNAME(h5gn_members_c) # define nh5glink_c FNAME(h5glink_c) +# define nh5glink2_c FNAME(h5glink2_c) # define nh5gunlink_c FNAME(h5gunlink_c) # define nh5gmove_c FNAME(h5gmove_c) +# define nh5gmove2_c FNAME(h5gmove2_c) # define nh5gget_linkval_c FNAME(h5gget_linkval_c) # define nh5gset_comment_c FNAME(h5gset_comment_c) # define nh5gget_comment_c FNAME(h5gget_comment_c) @@ -291,12 +295,18 @@ H5_DLL int_f nh5gn_members_c H5_DLL int_f nh5glink_c (hid_t_f *loc_id, int_f *link_type, _fcd current_name, int_f *current_namelen, _fcd new_name, int_f *new_namelen); +H5_DLL int_f nh5glink2_c +(hid_t_f *cur_loc_id, _fcd cur_name, int_f *cur_namelen, int_f *link_type, hid_t_f *new_loc_id, _fcd new_name, int_f *new_namelen); + H5_DLL int_f nh5gunlink_c (hid_t_f *loc_id, _fcd name, int_f *namelen); H5_DLL int_f nh5gmove_c (hid_t_f *loc_id, _fcd src_name, int_f *src_namelen, _fcd dst_name, int_f *dst_namelen); +H5_DLL int_f nh5gmove2_c +(hid_t_f *src_loc_id, _fcd src_name, int_f *src_namelen, hid_t_f *dst_loc_id,_fcd dst_name, int_f *dst_namelen); + H5_DLL int_f nh5gget_linkval_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size, _fcd value ); diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90 index f4b17f5..e10c4c8 100644 --- a/fortran/test/tH5G.f90 +++ b/fortran/test/tH5G.f90 @@ -17,7 +17,7 @@ ! This subroutine tests following functionalities: ! h5gcreate_f, h5gopen_f, h5gclose_f, (?)h5gget_obj_info_idx_f, h5gn_members_f -! h5glink_f, h5gunlink_f, h5gmove_f, h5gget_linkval_f, h5gset_comment_f, +! h5glink(2)_f, h5gunlink_f, h5gmove(2)_f, h5gget_linkval_f, h5gset_comment_f, ! h5gget_comment_f USE HDF5 ! This module contains all necessary modules @@ -46,6 +46,7 @@ INTEGER(HID_T) :: group2_id ! Group identifier INTEGER(HID_T) :: dset1_id ! Dataset identifier INTEGER(HID_T) :: dset2_id ! Dataset identifier + INTEGER(HID_T) :: dsetnew_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Data space identifier INTEGER, DIMENSION(1) :: dset1_data = 34 ! Data value @@ -122,8 +123,8 @@ ! !Create a hard link to the group2 ! - CALL h5glink_f(file_id, H5G_LINK_HARD_F, groupname2, linkname2, error) - CALL check("h5glink_f",error,total_error) + CALL h5glink2_f(file_id, groupname2, H5G_LINK_HARD_F, file_id, linkname2, error) + CALL check("h5glink2_f",error,total_error) ! !Create a soft link to dataset11 ! @@ -210,8 +211,19 @@ write(*,*) "got comment ", commentout, " is wrong" total_error = total_error +1 end if + ! + ! Move dataset1 to gourp2_id location + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f", error, total_error) - + CALL h5gmove2_f(file_id, dsetname1, group2_id, "dset1", error) + CALL check("h5gmove2_f", error, total_error) + ! + ! Open dataset from the new location + ! + Call h5dopen_f(file_id, "/MyGroup/Group_A/dset1" , dsetnew_id, error) + CALL check("h5dopen_f",error, total_error) ! !release all the resources ! @@ -221,10 +233,10 @@ CALL check("h5gclose_f", error, total_error) CALL h5gclose_f(group2_id, error) CALL check("h5gclose_f", error, total_error) - CALL h5dclose_f(dset1_id, error) - CALL check("h5dclose_f", error, total_error) CALL h5dclose_f(dset2_id, error) CALL check("h5dclose_f", error, total_error) + CALL h5dclose_f(dsetnew_id, error) + CALL check("h5dclose_f", error, total_error) CALL h5sclose_f(dspace_id, error) CALL check("h5sclose_f", error, total_error) |