mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-02-17 16:10:24 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r22392] Added test for h5tcreate_f with H5T_STRING_F option.

Browse Source 
Cleaned-up formating and comments for h5tcreate_f.

Tested: jam (gnu compiler)
This commit is contained in:
Scot Breitenfeld 2012-05-22 23:47:31 -05:00
parent b904ca7ec3
commit 24810fd216
2 changed files with 73 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
fortran/src/H5Tff.f90
View File

@ -2050,17 +2050,19 @@ CONTAINS
! h5tcreate_f
!
! PURPOSE
! Creates a new dataype
! Creates a new datatype.
!
! INPUTS
! class - datatype class, possible values are:
! H5T_COMPOUND_F
! H5T_ENUM_F
! H5T_OPAQUE_F
! size - datattype size
! class - Datatype class can be one of:
! H5T_COMPOUND_F
! H5T_ENUM_F
! H5T_OPAQUE_F
! H5T_STRING_F
!
! size - Size of the datatype.
! OUTPUTS
! type_id - datatype identifier
! hdferr - Returns 0 if successful and -1 if fails
! type_id - Datatype identifier.
! hdferr - Returns 0 if successful and -1 if fails
!
! AUTHOR
! Elena Pourmal
@ -2072,29 +2074,26 @@ CONTAINS
! port). March 7, 2001
! SOURCE
SUBROUTINE h5tcreate_f(class, size, type_id, hdferr)
IMPLICIT NONE
INTEGER, INTENT(IN) :: class ! Datatype class can be one of
! H5T_COMPOUND_F
! H5T_ENUM_F
! H5T_OPAQUE_F
INTEGER(SIZE_T), INTENT(IN) :: size ! Size of the datatype
INTEGER(HID_T), INTENT(OUT) :: type_id ! Datatype identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
IMPLICIT NONE
INTEGER , INTENT(IN) :: class
INTEGER(SIZE_T), INTENT(IN) :: size
INTEGER(HID_T) , INTENT(OUT) :: type_id
INTEGER , INTENT(OUT) :: hdferr
!*****
INTERFACE
INTEGER FUNCTION h5tcreate_c(class, size, type_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5TCREATE_C'::h5tcreate_c
!DEC$ENDIF
INTEGER, INTENT(IN) :: class
INTEGER(SIZE_T), INTENT(IN) :: size
INTEGER(HID_T), INTENT(OUT) :: type_id
END FUNCTION h5tcreate_c
END INTERFACE
INTERFACE
INTEGER FUNCTION h5tcreate_c(class, size, type_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5TCREATE_C'::h5tcreate_c
!DEC$ENDIF
INTEGER, INTENT(IN) :: class
INTEGER(SIZE_T), INTENT(IN) :: size
INTEGER(HID_T), INTENT(OUT) :: type_id
END FUNCTION h5tcreate_c
END INTERFACE
hdferr = h5tcreate_c(class, size, type_id)
END SUBROUTINE h5tcreate_f
hdferr = h5tcreate_c(class, size, type_id)
END SUBROUTINE h5tcreate_f
!
!****s* H5T/h5tinsert_f

45
fortran/test/tH5T.f90
View File

@ -108,6 +108,51 @@
INTEGER(HID_T) :: decoded_sid1
INTEGER(HID_T) :: decoded_tid1
INTEGER(HID_T) :: fixed_str1, fixed_str2
LOGICAL :: are_equal
INTEGER(SIZE_T), PARAMETER :: str_size = 10
INTEGER(SIZE_T) :: query_size
! Test h5tcreate_f with H5T_STRING_F option:
! Create fixed-length string in two ways and make sure they are the same
CALL h5tcopy_f(H5T_FORTRAN_S1, fixed_str1, error)
CALL check("h5tcopy_f", error, total_error)
CALL h5tset_size_f(fixed_str1, str_size, error)
CALL check("h5tset_size_f", error, total_error)
CALL h5tset_strpad_f(fixed_str1, H5T_STR_NULLTERM_F, error)
CALL check("h5tset_strpad_f", error, total_error)
CALL h5tcreate_f(H5T_STRING_F, str_size, fixed_str2, error)
CALL check("h5tcreate_f", error, total_error)
CALL h5tset_strpad_f(fixed_str2, H5T_STR_NULLTERM_F, error)
CALL check("h5tset_strpad_f", error, total_error)
CALL h5tequal_f(fixed_str1, fixed_str2, are_equal, error)
IF(.NOT.are_equal)THEN
CALL check("h5tcreate_f", -1, total_error)
ENDIF
CALL h5tget_size_f(fixed_str1, query_size, error)
CALL check("h5tget_size_f", error, total_error)
IF(query_size.NE.str_size)THEN
CALL check("h5tget_size_f", -1, total_error)
ENDIF
CALL h5tget_size_f(fixed_str2, query_size, error)
CALL check("h5tget_size_f", error, total_error)
IF(query_size.NE.str_size)THEN
CALL check("h5tget_size_f", -1, total_error)
ENDIF
CALL h5tclose_f(fixed_str1,error)
CALL check("h5tclose_f", error, total_error)
CALL h5tclose_f(fixed_str2,error)
CALL check("h5tclose_f", error, total_error)
data_dims(1) = dimsize
!
! Initialize data buffer.