summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Of.c57
-rw-r--r--fortran/src/H5Off.f9072
-rw-r--r--fortran/src/H5f90proto.h7
-rw-r--r--fortran/test/tH5O.f9053
4 files changed, 186 insertions, 3 deletions
diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c
index 0df433a..531f09c 100644
--- a/fortran/src/H5Of.c
+++ b/fortran/src/H5Of.c
@@ -334,3 +334,60 @@ nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *
return ret_value;
}
+/* ***if* H5Of/H5Ocopy_c
+ * NAME
+ * H5Ocopy_c
+ * PURPOSE
+ * Calls H5Ocopy
+ * INPUTS
+ * src_loc_id - Object identifier indicating the location of the source object to be copied
+ * src_name - Name of the source object to be copied
+ * src_name_len - Length of src_name
+ * dst_loc_id - Location identifier specifying the destination
+ * dst_name - Name to be assigned to the new copy
+ * dst_name_len - Length of dst_name
+ * ocpypl_id - Object copy property list
+ * lcpl_id - Link creation property list for the new hard link
+ *
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * March 14, 2012
+ * SOURCE
+*/
+int_f
+nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
+ hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len,
+ hid_t_f *ocpypl_id, hid_t_f *lcpl_id )
+/******/
+{
+ char *c_src_name = NULL; /* Buffer to hold C string */
+ char *c_dst_name = NULL; /* Buffer to hold C string */
+
+ int_f ret_value = 0; /* Return value */
+
+ /*
+ * Convert FORTRAN name to C name
+ */
+ if((c_src_name = HD5f2cstring(src_name, (size_t)*src_name_len)) == NULL)
+ HGOTO_DONE(FAIL);
+ if((c_dst_name = HD5f2cstring(dst_name, (size_t)*dst_name_len)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Ocopy function.
+ */
+ if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name,
+ (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ if(c_src_name)
+ HDfree(c_src_name);
+ if(c_dst_name)
+ HDfree(c_dst_name);
+
+ return ret_value;
+
+}
diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90
index e69fdb5..04c96e2 100644
--- a/fortran/src/H5Off.f90
+++ b/fortran/src/H5Off.f90
@@ -250,5 +250,77 @@ CONTAINS
END SUBROUTINE h5oopen_by_addr_f
+!
+!****s* H5O/h5ocopy_f
+! NAME
+! h5ocopy_f
+!
+! PURPOSE
+! Copies an object in an HDF5 file.
+!
+! INPUTS
+! src_loc_id - Object identifier indicating the location of the source object to be copied
+! src_name - Name of the source object to be copied
+! dst_loc_id - Location identifier specifying the destination
+! dst_name - Name to be assigned to the new copy
+!
+! OPTIONAL PARAMETERS
+! ocpypl_id - Object copy property list
+! lcpl_id - Link creation property list for the new hard link
+!
+! OUTPUTS:
+! hdferr - Returns 0 if successful and -1 if fails
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! March 14, 2012
+!
+! SOURCE
+ SUBROUTINE h5ocopy_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr, ocpypl_id, lcpl_id)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: src_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: src_name
+ INTEGER(HID_T) , INTENT(IN) :: dst_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: dst_name
+ INTEGER, INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: ocpypl_id
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lcpl_id
+!*****
+
+ INTEGER(SIZE_T) :: src_name_len, dst_name_len
+ INTEGER(HID_T) :: ocpypl_id_default, lcpl_id_default
+
+ INTERFACE
+ INTEGER FUNCTION h5ocopy_c(src_loc_id, src_name, src_name_len, &
+ dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OCOPY_C'::h5ocopy_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: src_name, dst_name
+ INTEGER(HID_T) , INTENT(IN) :: src_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: src_name
+ INTEGER(HID_T) , INTENT(IN) :: dst_loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: dst_name
+ INTEGER(HID_T) , INTENT(IN) :: ocpypl_id_default
+ INTEGER(HID_T) , INTENT(IN) :: lcpl_id_default
+ INTEGER(SIZE_T) :: src_name_len, dst_name_len
+
+ END FUNCTION h5ocopy_c
+ END INTERFACE
+
+ src_name_len = LEN(src_name)
+ dst_name_len = LEN(dst_name)
+
+ ocpypl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(ocpypl_id)) ocpypl_id_default = ocpypl_id
+ lcpl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id
+
+ hdferr = h5ocopy_c(src_loc_id, src_name, src_name_len, &
+ dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default)
+
+ END SUBROUTINE h5ocopy_f
+
END MODULE H5O
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 89957a4..a504653 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -805,10 +805,12 @@ H5_FCDLL int_f nh5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts,
#define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C)
#define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C)
-#define nh5oclose_c H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C)
+#define nh5oclose_c H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C)
#define nh5ovisit_c H5_FC_FUNC_(h5ovisit_c,H5OVISIT_C)
#define nh5oget_info_by_name_c H5_FC_FUNC_(h5oget_info_by_name_c ,H5OGET_INFO_BY_NAME_C)
#define nh5oopen_by_addr_c H5_FC_FUNC_(h5oopen_by_addr_c, H5OOPEN_BY_ADDR_C)
+#define nh5ocopy_c H5_FC_FUNC_(h5ocopy_c, H5OCOPY_C)
+
H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id);
H5_FCDLL int_f nh5oclose_c (hid_t_f *object_id );
@@ -818,6 +820,9 @@ H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, s
H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data);
H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id,
H5O_info_t_f *object_info);
+H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
+ hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len,
+ hid_t_f *ocpypl_id, hid_t_f *lcpl_id );
/*
* Functions from H5Pf.c
*/
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index d871e59..f49906b 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -87,6 +87,11 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER :: i, n, j
INTEGER :: error ! /* Value returned from API calls */
+ CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT"
+ CHARACTER(LEN=16) :: NAME_DATATYPE_SIMPLE2="H5T_NATIVE_INT-2"
+ INTEGER(HID_T) :: tid, tid2
+ LOGICAL :: flag
+
! /* Initialize the raw data */
DO i = 1, TEST6_DIM1
DO j = 1, TEST6_DIM2
@@ -222,8 +227,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tclose_f(type_id, error)
CALL check("h5tclose_f",error,total_error)
- CALL h5fclose_f(file_id, error)
- CALL check("h5fclose_f",error,total_error)
! /* Close remaining IDs */
CALL h5sclose_f(space_id, error)
@@ -231,6 +234,52 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5pclose_f(lcpl_id,error)
CALL check("h5pclose_f", error, total_error)
+
+ ! *********************
+ ! CHECK H5OCOPY_F
+ ! *********************
+
+ ! create datatype
+ CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+ CALL check("h5tcopy_f", error, total_error)
+
+ ! create named datatype
+ CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
+ CALL check("h5tcommit_f", error, total_error)
+
+ ! close the datatype
+ CALL h5tclose_f(tid, error)
+ CALL check("h5tclose_f",error)
+
+ CALL h5ocopy_f(file_id, NAME_DATATYPE_SIMPLE, file_id, NAME_DATATYPE_SIMPLE2, error)
+ CALL check("h5ocopy_f",error,total_error)
+
+ ! open the datatype for copy
+ CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
+ CALL check("h5topen_f",error,total_error)
+
+ ! open the copied datatype
+ CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE2, tid2, error)
+ CALL check("h5topen_f",error,total_error)
+
+ ! Compare the datatypes
+ CALL h5tequal_f(tid, tid2, flag, error)
+ IF(.NOT.flag)THEN
+ WRITE(*,*) "h5ocopy_f FAILED"
+ total_error = total_error + 1
+ ENDIF
+
+ ! close the destination datatype
+ CALL h5tclose_f(tid, error)
+ CALL check("h5tclose_f",error,total_error)
+
+ ! close the destination datatype
+ CALL h5tclose_f(tid2, error)
+ CALL check("h5tclose_f",error,total_error)
+
+ CALL h5fclose_f(file_id, error)
+ CALL check("h5fclose_f",error,total_error)
+
END SUBROUTINE test_h5o_link
!/****************************************************************