diff options
| -rw-r--r-- | fortran/src/H5Tf.c | 46 | ||||
| -rw-r--r-- | fortran/src/H5Tff.f90 | 51 | ||||
| -rw-r--r-- | fortran/src/H5Tff_F03.f90 | 100 | ||||
| -rw-r--r-- | fortran/src/H5Tff_F90.f90 | 53 | ||||
| -rw-r--r-- | fortran/src/H5_f.c | 1 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 2 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.f90 | 25 | ||||
| -rw-r--r-- | src/H5Tconv.c | 4 |
8 files changed, 225 insertions, 57 deletions
diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index ca9c30f..c406c28 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -1772,7 +1772,7 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) 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); HDfree(c_name); if(error < 0) return ret_value; @@ -1781,6 +1781,50 @@ nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) return ret_value; } +/****if* H5Tf/h5tenum_insert_ptr_c + * NAME + * h5tenum_insert_c + * PURPOSE + * Call H5Tenum_insert to insert a new enumeration datatype member. + * INPUTS + * type_id - Datatype identifier for the enumeration datatype. + * name - Name of the new member. + * namelen - length of the name. + * value - Pointer to the value of the new member. + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * September 25, 2014 + * HISTORY + * + * SOURCE +*/ +int_f +nh5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value) +/******/ +{ + int ret_value = -1; + hid_t c_type_id; + char* c_name; + size_t c_namelen; + int_f c_value; + herr_t error; + + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_type_id = (hid_t)*type_id; + + error = H5Tenum_insert(c_type_id, c_name, value); + HDfree(c_name); + if(error < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + /****if* H5Tf/h5tenum_nameof_c * NAME 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..60a83e9 100644 --- a/fortran/src/H5Tff_F03.f90 +++ b/fortran/src/H5Tff_F03.f90 @@ -47,6 +47,12 @@ MODULE H5T_PROVISIONAL !***** + INTERFACE h5tenum_insert_f + MODULE PROCEDURE h5tenum_insert_integer + ! Recommended procedure: + MODULE PROCEDURE h5tenum_insert_ptr + END INTERFACE + CONTAINS !****s* H5T (F03)/H5Tconvert_f_F03 @@ -112,5 +118,99 @@ CONTAINS END SUBROUTINE h5tconvert_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_integer(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(C_INT), TARGET :: c_value + TYPE(C_PTR) :: f_ptr + + PRINT*,'b',value + ! make sure 'value' is the same type as the C int + c_value = INT(value, C_INT) + f_ptr = C_LOC(c_value) + + + PRINT*,value + CALL h5tenum_insert_ptr(type_id, name, f_ptr, hdferr) + END SUBROUTINE h5tenum_insert_integer + +! +!****s* H5T/h5tenaum_insert_f_F03 +! +! NAME +! h5tenaum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Name of the new member. +! value - Pointer to the value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! September 25, 2014 +! +! HISTORY +! SOURCE + SUBROUTINE h5tenum_insert_ptr(type_id, name, value, hdferr) + USE, INTRINSIC :: ISO_C_BINDING + 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) + USE H5GLOBAL + USE, INTRINSIC :: ISO_C_BINDING + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_PTR_C'::h5tenum_insert_ptr_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(C_PTR), VALUE :: value + INTEGER :: namelen + 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_ptr + END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5Tff_F90.f90 b/fortran/src/H5Tff_F90.f90 index a95b31f..f2ff543 100644 --- a/fortran/src/H5Tff_F90.f90 +++ b/fortran/src/H5Tff_F90.f90 @@ -36,4 +36,57 @@ MODULE H5T_PROVISIONAL + USE H5GLOBAL + +CONTAINS +! +!****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 + END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index a149109..4a5fcbc 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -227,7 +227,6 @@ nh5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertype if ((floatingtypes[1] = (hid_t_f)H5Tcopy(H5T_IEEE_F32LE)) < 0) return ret_value; if ((floatingtypes[2] = (hid_t_f)H5Tcopy(H5T_IEEE_F64BE)) < 0) return ret_value; if ((floatingtypes[3] = (hid_t_f)H5Tcopy(H5T_IEEE_F64LE)) < 0) return ret_value; - if ((integertypes[0] = (hid_t_f)H5Tcopy(H5T_STD_I8BE)) < 0) return ret_value; if ((integertypes[1] = (hid_t_f)H5Tcopy(H5T_STD_I8LE)) < 0) return ret_value; if ((integertypes[2] = (hid_t_f)H5Tcopy(H5T_STD_I16BE)) < 0) return ret_value; diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 284ffbd..b4c715f 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -709,6 +709,7 @@ H5_FCDLL int_f nh5arename_c( hid_t_f *loc_id, #define nh5tinsert_array_c2 H5_FC_FUNC_(h5tinsert_array_c2, H5TINSERT_ARRAY_C2) #define nh5tenum_create_c H5_FC_FUNC_(h5tenum_create_c, H5TENUM_CREATE_C) #define nh5tenum_insert_c H5_FC_FUNC_(h5tenum_insert_c, H5TENUM_INSERT_C) +#define nh5tenum_insert_ptr_c H5_FC_FUNC_(h5tenum_insert_ptr_c, H5TENUM_INSERT_PTR_C) #define nh5tenum_nameof_c H5_FC_FUNC_(h5tenum_nameof_c, H5TENUM_NAMEOF_C) #define nh5tenum_valueof_c H5_FC_FUNC_(h5tenum_valueof_c, H5TENUM_VALUEOF_C) #define nh5tget_member_value_c H5_FC_FUNC_(h5tget_member_value_c, H5TGET_MEMBER_VALUE_C) @@ -772,6 +773,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 nh5tenum_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/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index f15424d..cf27284 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -1379,7 +1379,8 @@ SUBROUTINE t_enum(total_error) INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/dim0, dim1/) INTEGER, DIMENSION(1:dim0, 1:dim1), TARGET :: wdata ! Write buffer INTEGER, DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata ! Read buffer - INTEGER, DIMENSION(1:1), TARGET :: val + INTEGER(C_INT), DIMENSION(1:1), TARGET :: val + INTEGER(C_INT), TARGET :: c_val CHARACTER(LEN=6), DIMENSION(1:4) :: & names = (/"SOLID ", "LIQUID", "GAS ", "PLASMA"/) @@ -1398,6 +1399,12 @@ SUBROUTINE t_enum(total_error) wdata(i,j) = MOD( (j-1)*(i-1), PLASMA+1) ENDDO ENDDO + PRINT*,F_BASET,M_BASET + val(1) = 0 +!!$ f_ptr = C_LOC(val(1)) +!!$ CALL H5Tconvert_f(M_BASET, F_BASET, INT(1,SIZE_T), f_ptr, error) +!!$ stop + ! ! Create a new file using the default properties. ! @@ -1419,18 +1426,28 @@ 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) + ! c_val = val(1) + f_ptr = C_LOC(val(1)) + CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), f_ptr, error) CALL check("H5Tenum_insert_f", error, total_error) ! ! Insert enumerated value for filetype. We must first convert ! the numerical value val to the base type of the destination. ! - f_ptr = C_LOC(val(1)) + ! f_ptr = C_LOC(val(1)) + ! c_val = val(1) + ! f_ptr = C_LOC(c_val) + PRINT*,'a0',val(1), sizeof(val(1)) CALL H5Tconvert_f(M_BASET, F_BASET, INT(1,SIZE_T), f_ptr, error) + ! val(1) = c_val + PRINT*,'aa',val(1) + ! if(i.eq.1)stop CALL check("H5Tconvert_f",error, total_error) - CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), error) + CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), f_ptr, error) CALL check("H5Tenum_insert_f",error, total_error) + if(i.eq.1) STOP ENDDO + stop ! ! Create dataspace. Setting maximum size to be the current size. ! diff --git a/src/H5Tconv.c b/src/H5Tconv.c index 58b0b46..9dd2cac 100644 --- a/src/H5Tconv.c +++ b/src/H5Tconv.c @@ -3410,6 +3410,7 @@ H5T__conv_array(hid_t src_id, hid_t dst_id, H5T_cdata_t *cdata, size_t nelmts, FUNC_ENTER_PACKAGE + printf("conv_array\n"); switch (cdata->command) { case H5T_CONV_INIT: /* @@ -3579,6 +3580,8 @@ H5T__conv_i_i(hid_t src_id, hid_t dst_id, H5T_cdata_t *cdata, size_t nelmts, FUNC_ENTER_PACKAGE + printf("**H5T__conv_i_i\n"); + switch(cdata->command) { case H5T_CONV_INIT: if(NULL == (src = (H5T_t *)H5I_object(src_id)) || NULL == (dst = (H5T_t *)H5I_object(dst_id))) @@ -3615,6 +3618,7 @@ H5T__conv_i_i(hid_t src_id, hid_t dst_id, H5T_cdata_t *cdata, size_t nelmts, olap = (size_t)olap_d; sp = dp = (uint8_t*)buf; + printf("sp %d\n", *sp); direction = 1; } else { double olap_d = HDceil((double)(src->shared->size)/ |