diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-02-25 22:26:08 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-02-25 22:26:08 (GMT) |
commit | fc44136ee740a0f50eb0956d66c945f4bc7ae6fa (patch) | |
tree | 6be5a42b3a941fd1c27b085916edaeb928d13862 /fortran | |
parent | 4e1ebd70f526bd3d7ac07c5523d0501350f559d8 (diff) | |
download | hdf5-fc44136ee740a0f50eb0956d66c945f4bc7ae6fa.zip hdf5-fc44136ee740a0f50eb0956d66c945f4bc7ae6fa.tar.gz hdf5-fc44136ee740a0f50eb0956d66c945f4bc7ae6fa.tar.bz2 |
[svn-r26308] Merged r26214, 26217, 26233, 26241 from the trunk.
Diffstat (limited to 'fortran')
-rw-r--r-- | fortran/src/H5Tf.c | 72 | ||||
-rw-r--r-- | fortran/src/H5Tff.f90 | 51 | ||||
-rw-r--r-- | fortran/src/H5Tff_F03.f90 | 107 | ||||
-rw-r--r-- | fortran/src/H5Tff_F90.f90 | 56 | ||||
-rw-r--r-- | fortran/src/H5f90proto.h | 1 | ||||
-rw-r--r-- | fortran/src/hdf5_fortrandll.def.in | 4 | ||||
-rw-r--r-- | fortran/test/tH5T_F03.f90 | 20 |
7 files changed, 237 insertions, 74 deletions
diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index ca9c30f..878119f 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -1738,21 +1738,23 @@ nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id) /****if* H5Tf/h5tenum_insert_c * NAME - * h5tenum_insert_c + * h5tenum_insert_c * PURPOSE - * Call H5Tenum_insert to insert a new enumeration datatype member. + * Call H5Tenum_insert to insert a new enumeration datatype member. * INPUTS - * type_id - identifier of the datatype - * name - Name of the new member - * namelen - length of the name - * value - value of the new member + * type_id - identifier of the datatype + * name - Name of the new member + * namelen - length of the name + * value - value of the new member * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * XIANGYANG SU - * Thursday, February 3, 2000 + * Thursday, February 3, 2000 * HISTORY - * + * 'value' is no longer cast into an int. If the user passes in an 8 byte integer then + * it should not be cast to an int (which might be 4 bytes). Instead the value + * is written as the size of an int_f. * SOURCE */ @@ -1761,19 +1763,18 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) /******/ { int ret_value = -1; - hid_t c_type_id; char* c_name; size_t c_namelen; - int_f c_value; herr_t error; + int_f c_value; c_namelen = *namelen; c_name = (char *)HD5f2cstring(name, c_namelen); if (c_name == NULL) return ret_value; - c_type_id = (hid_t)*type_id; - c_value = (int)*value; - error = H5Tenum_insert(c_type_id, c_name, &c_value); + c_value = *value; + error = H5Tenum_insert((hid_t)*type_id, c_name, &c_value); + HDfree(c_name); if(error < 0) return ret_value; @@ -2421,3 +2422,46 @@ h5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts, void *buf, void return ret_value; } +/****if* H5Tf/h5tenum_insert_ptr_c + * NAME + * /h5tenum_insert_ptr_c + * PURPOSE + * Calls H5Tenum_insert + * INPUTS + * type_id - Datatype identifier for the enumeration datatype. + * name - Datatype identifier. + * value - Pointer to the value of the new member. + * + * OUTPUTS + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * February 6, 2015 + * + * SOURCE +*/ +int_f +h5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value) +/******/ +{ + int ret_value = -1; + hid_t status; + char *c_name; + size_t c_namelen; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + status = H5Tenum_insert( (hid_t)*type_id, c_name, value); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + + diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90 index 0e1dbb0..4b4c0b6 100644 --- a/fortran/src/H5Tff.f90 +++ b/fortran/src/H5Tff.f90 @@ -2335,57 +2335,6 @@ CONTAINS hdferr = h5tenum_create_c(parent_id, new_type_id) END SUBROUTINE h5tenum_create_f - -! -!****s* H5T/h5tenaum_insert_f -! -! NAME -! h5tenaum_insert_f -! -! PURPOSE -! Inserts a new enumeration datatype member. -! -! INPUTS -! type_id - datatype identifier -! OUTPUTS -! hdferr - Returns 0 if successful and -1 if fails -! -! AUTHOR -! Elena Pourmal -! August 12, 1999 -! -! HISTORY -! Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). March 7, 2001 -! SOURCE - SUBROUTINE h5tenum_insert_f(type_id, name, value, hdferr) - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier - CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member - INTEGER, INTENT(IN) :: value !value of the new member - INTEGER, INTENT(OUT) :: hdferr ! Error code -!***** - INTEGER :: namelen - - INTERFACE - INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) - USE H5GLOBAL - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c - !DEC$ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: type_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER, INTENT(IN) :: value - INTEGER :: namelen - END FUNCTION h5tenum_insert_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5tenum_insert_c(type_id, name, namelen, value) - END SUBROUTINE h5tenum_insert_f - ! !****s* H5T/h5tenum_nameof_f ! diff --git a/fortran/src/H5Tff_F03.f90 b/fortran/src/H5Tff_F03.f90 index 2405837..2c9f212 100644 --- a/fortran/src/H5Tff_F03.f90 +++ b/fortran/src/H5Tff_F03.f90 @@ -47,6 +47,11 @@ MODULE H5T_PROVISIONAL !***** + INTERFACE h5tenum_insert_f + MODULE PROCEDURE h5tenum_insert_f03 + MODULE PROCEDURE h5tenum_insert_f90 + END INTERFACE + CONTAINS !****s* H5T (F03)/H5Tconvert_f_F03 @@ -93,6 +98,7 @@ CONTAINS BIND(C, NAME='h5tconvert_c') USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE H5GLOBAL + IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: src_id INTEGER(HID_T) , INTENT(IN) :: dst_id INTEGER(SIZE_T), INTENT(IN) :: nelmts @@ -111,6 +117,107 @@ CONTAINS hdferr = H5Tconvert_c(src_id, dst_id, nelmts, buf, background_default, plist_id_default) END SUBROUTINE h5tconvert_f +! +!****s* (F03) H5T/h5tenum_insert_f90 +! +! NAME +! h5tenum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! SOURCE + SUBROUTINE h5tenum_insert_f90(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member + INTEGER, INTENT(IN) :: value ! value of the new member + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: namelen + INTERFACE + INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER :: namelen + END FUNCTION h5tenum_insert_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f90 + +! +!****s* (F03) H5T/h5tenum_insert_f03 +! +! NAME +! h5tenum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Pointer to the value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! February 6, 2015 +! +! HISTORY +! F2003 implementation of function +! SOURCE + SUBROUTINE h5tenum_insert_f03(type_id, name, value, hdferr) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_char + USE H5GLOBAL + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(C_PTR) , INTENT(IN) :: value + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER :: namelen + + INTERFACE + INTEGER FUNCTION h5tenum_insert_ptr_c(type_id, name, namelen, value) & + BIND(C, NAME='h5tenum_insert_ptr_c') + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_char + USE H5GLOBAL + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: type_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + INTEGER :: namelen + TYPE(C_PTR), VALUE :: value + END FUNCTION h5tenum_insert_ptr_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_ptr_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f03 END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5Tff_F90.f90 b/fortran/src/H5Tff_F90.f90 index a95b31f..380fbec 100644 --- a/fortran/src/H5Tff_F90.f90 +++ b/fortran/src/H5Tff_F90.f90 @@ -36,4 +36,60 @@ MODULE H5T_PROVISIONAL + USE H5GLOBAL + +CONTAINS + +! +!****s* H5T/h5tenum_insert_f +! +! NAME +! h5tenum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! SOURCE + SUBROUTINE h5tenum_insert_f(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER :: namelen + + INTERFACE + INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER :: namelen + END FUNCTION h5tenum_insert_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f + END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 284ffbd..b5e40a8 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -772,6 +772,7 @@ H5_FCDLL int_f nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen H5_FCDLL 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); H5_FCDLL int_f nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id); H5_FCDLL int_f nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); +H5_FCDLL int_f h5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value); H5_FCDLL int_f nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen); H5_FCDLL int_f nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); H5_FCDLL int_f nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index c9c5e76..48fb343 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -543,7 +543,6 @@ H5T_mp_H5TINSERT_F H5T_mp_H5TPACK_F H5T_mp_H5TARRAY_CREATE_F H5T_mp_H5TENUM_CREATE_F -H5T_mp_H5TENUM_INSERT_F H5T_mp_H5TENUM_NAMEOF_F H5T_mp_H5TENUM_VALUEOF_F H5T_mp_H5TGET_MEMBER_VALUE_F @@ -560,6 +559,9 @@ H5T_mp_H5TGET_CREATE_PLIST_F H5T_mp_H5TCOMPILER_CONV_F H5T_mp_H5TGET_NATIVE_TYPE_F @H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TCONVERT_F +@H5_F03EXP@H5T_PROVISIONAL_mp_H5TENUM_INSERT_F +@H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TENUM_INSERT_F90 +@H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TENUM_INSERT_F03 ; H5Z H5Z_mp_H5ZUNREGISTER_F H5Z_mp_H5ZFILTER_AVAIL_F diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index f15424d..e019d0f 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -1419,7 +1419,7 @@ SUBROUTINE t_enum(total_error) ! Insert enumerated value for memtype. ! val(1) = i - CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), val(1), error) + CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), C_LOC(val(1)), error) CALL check("H5Tenum_insert_f", error, total_error) ! ! Insert enumerated value for filetype. We must first convert @@ -1428,7 +1428,11 @@ SUBROUTINE t_enum(total_error) f_ptr = C_LOC(val(1)) CALL H5Tconvert_f(M_BASET, F_BASET, INT(1,SIZE_T), f_ptr, error) CALL check("H5Tconvert_f",error, total_error) - CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), error) + IF(i.GE.1)THEN ! test both F90 and F03 APIs + CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), f_ptr, error) + ELSE + CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), error) + ENDIF CALL check("H5Tenum_insert_f",error, total_error) ENDDO ! @@ -3134,7 +3138,7 @@ SUBROUTINE t_enum_conv(total_error) ENUMERATOR :: E1_RED, E1_GREEN, E1_BLUE, E1_WHITE, E1_BLACK END ENUM - INTEGER :: val + INTEGER(KIND(E1_RED)), TARGET :: val ! Enumerated data array ! Some values are out of range for testing. The library should accept them @@ -3185,19 +3189,19 @@ SUBROUTINE t_enum_conv(total_error) ! Initialize enum data. ! val = E1_RED - CALL H5Tenum_insert_f(dtype, "RED", val, error) + CALL H5Tenum_insert_f(dtype, "RED", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) val = E1_GREEN - CALL H5Tenum_insert_f(dtype, "GREEN", val, error) + CALL H5Tenum_insert_f(dtype, "GREEN", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) val = E1_BLUE - CALL H5Tenum_insert_f(dtype, "BLUE", val, error) + CALL H5Tenum_insert_f(dtype, "BLUE", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) val = E1_WHITE - CALL H5Tenum_insert_f(dtype, "WHITE", val, error) + CALL H5Tenum_insert_f(dtype, "WHITE", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) val = E1_BLACK - CALL H5Tenum_insert_f(dtype, "BLACK", val, error) + CALL H5Tenum_insert_f(dtype, "BLACK", C_LOC(val), error) CALL check("h5tenum_insert_f",error, total_error) ! ! Create dataspace. Setting maximum size to be the current size. |