diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Tf.c | 46 | ||||
| -rw-r--r-- | fortran/src/H5Tff.f90 | 51 | ||||
| -rw-r--r-- | fortran/src/H5Tff_F03.f90 | 97 | ||||
| -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 |
7 files changed, 57 insertions, 218 deletions
diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index c406c28..ca9c30f 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,50 +1781,6 @@ 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 4b4c0b6..0e1dbb0 100644 --- a/fortran/src/H5Tff.f90 +++ b/fortran/src/H5Tff.f90 @@ -2335,6 +2335,57 @@ 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 616ff58..2405837 100644 --- a/fortran/src/H5Tff_F03.f90 +++ b/fortran/src/H5Tff_F03.f90 @@ -47,12 +47,6 @@ 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 @@ -118,96 +112,5 @@ 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 - - ! make sure 'value' is the same type as the C int - c_value = INT(value, C_INT) - f_ptr = C_LOC(c_value) - - CALL h5tenum_insert_ptr(type_id, name, f_ptr, hdferr) - END SUBROUTINE h5tenum_insert_integer - -! -!****s* H5T/h5tenum_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 24af4bb..a95b31f 100644 --- a/fortran/src/H5Tff_F90.f90 +++ b/fortran/src/H5Tff_F90.f90 @@ -36,57 +36,4 @@ MODULE H5T_PROVISIONAL - USE H5GLOBAL - -CONTAINS -! -!****s* H5T/h5tenum_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 4a5fcbc..a149109 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -227,6 +227,7 @@ 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 b4c715f..284ffbd 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -709,7 +709,6 @@ 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) @@ -773,7 +772,6 @@ 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 cf27284..f15424d 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -1379,8 +1379,7 @@ 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(C_INT), DIMENSION(1:1), TARGET :: val - INTEGER(C_INT), TARGET :: c_val + INTEGER, DIMENSION(1:1), TARGET :: val CHARACTER(LEN=6), DIMENSION(1:4) :: & names = (/"SOLID ", "LIQUID", "GAS ", "PLASMA"/) @@ -1399,12 +1398,6 @@ 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. ! @@ -1426,28 +1419,18 @@ SUBROUTINE t_enum(total_error) ! Insert enumerated value for memtype. ! val(1) = i - ! c_val = val(1) - f_ptr = C_LOC(val(1)) - CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), f_ptr, error) + CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), val(1), 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)) - ! c_val = val(1) - ! f_ptr = C_LOC(c_val) - PRINT*,'a0',val(1), sizeof(val(1)) + f_ptr = C_LOC(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)), f_ptr, error) + CALL H5Tenum_insert_f(filetype, TRIM(names(i+1)), val(1), 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. ! |