summaryrefslogtreecommitdiffstats
path: root/fortran/test/tH5T_F03.f90
diff options
context:
space:
mode:
Diffstat (limited to 'fortran/test/tH5T_F03.f90')
-rw-r--r--fortran/test/tH5T_F03.f90351
1 files changed, 349 insertions, 2 deletions
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index 1c4da8b..7336cf7 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -1028,8 +1028,8 @@ END SUBROUTINE test_array_compound_atomic
INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8) !should map to INTEGER*8 on most modern processors
- INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
- INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_8) !should map to REAL*8 on most modern processors
+ INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+ INTEGER, PARAMETER :: real_kind_15 = SELECTED_REAL_KIND(Fortran_REAL_8) !should map to REAL*8 on most modern processors
CHARACTER(LEN=12), PARAMETER :: filename = "dsetf_F03.h5" ! File name
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
@@ -3092,3 +3092,350 @@ SUBROUTINE test_nbit(cleanup, total_error )
END SUBROUTINE test_nbit
+SUBROUTINE t_enum_conv(total_error)
+
+!-------------------------------------------------------------------------
+! Subroutine: t_enum_conv
+!
+! Purpose: Tests converting data from enumeration datatype
+! to numeric (integer or floating-point number)
+! datatype. Tests various KINDs of INTEGERs
+! and REALs. Checks reading enum data into
+! INTEGER and REAL KINDs.
+!
+! Return: Success: 0
+! Failure: number of errors
+!
+! Programmer: M. Scot Breitenfeld
+! October 27, 2012
+!
+! Note: Adapted from C test (enum.c -- test_conv)
+! No reliance on C tests.
+!-------------------------------------------------------------------------
+!
+ USE HDF5
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) !should map to INTEGER*4 on most modern processors
+ INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(Fortran_INTEGER_8)!should map to INTEGER*8 on most modern processors
+
+ INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
+
+ INTEGER(hid_t) :: cwg=-1, dtype=-1, space=-1, dset=-1, memtype ! Handles
+ INTEGER(hid_t) :: file ! Handles
+
+ ! Enumerated type
+ ENUM, BIND(C)
+ ENUMERATOR :: E1_RED, E1_GREEN, E1_BLUE, E1_WHITE, E1_BLACK
+ END ENUM
+
+ INTEGER :: val
+
+ ! Enumerated data array
+ ! Some values are out of range for testing. The library should accept them
+ INTEGER(KIND(E1_RED)), DIMENSION(1:20), TARGET :: data1 = (/E1_RED, E1_GREEN, E1_BLUE, E1_GREEN, E1_WHITE,&
+ E1_WHITE, E1_BLACK, E1_GREEN, E1_BLUE, E1_RED,&
+ E1_RED, E1_BLUE, E1_GREEN, E1_BLACK, E1_WHITE,&
+ E1_RED, E1_WHITE, INT(0,KIND(E1_RED)), INT(-1,KIND(E1_RED)), INT(-2,KIND(E1_RED))/)
+
+ ! Reading array for enum data
+ INTEGER(KIND(E1_RED)), DIMENSION(1:20), TARGET :: data2
+
+ ! Reading array's for converted enum data
+ INTEGER(C_SHORT), DIMENSION(1:20), TARGET :: data_short
+ INTEGER(C_INT), DIMENSION(1:20), TARGET :: data_int
+ REAL(C_DOUBLE), DIMENSION(1:20), TARGET :: data_double
+
+ INTEGER(int_kind_8), DIMENSION(1:20), TARGET :: data_i8
+ INTEGER(int_kind_16), DIMENSION(1:20), TARGET :: data_i16
+ REAL(real_kind_7), DIMENSION(1:20), TARGET :: data_r7
+
+ INTEGER(hsize_t), DIMENSION(1:1) :: ds_size = (/20/)
+ INTEGER(size_t) :: i
+ INTEGER :: error
+ TYPE(C_PTR) :: f_ptr
+ INTEGER(HID_T) :: m_baset ! Memory base type
+ !
+ ! Create a new file using the default properties.
+ !
+ CALL h5fcreate_f("enum1.h5", H5F_ACC_TRUNC_F, file, error)
+ CALL check("h5fcreate_f", error, total_error)
+ !
+ ! Create a new group using the default properties.
+ !
+ CALL h5gcreate_f(file, "test_conv", cwg, error)
+ CALL check("h5gcreate_f",error, total_error)
+ !
+ ! Create a enum type
+ !
+ CALL H5Tcreate_f(H5T_ENUM_F, H5OFFSETOF(C_LOC(data1(1)), C_LOC(data1(2))), dtype, error)
+ CALL check("h5tcreate_f",error, total_error)
+ !
+ ! Initialize enum data.
+ !
+ val = E1_RED
+ CALL H5Tenum_insert_f(dtype, "RED", val, error)
+ CALL check("h5tenum_insert_f",error, total_error)
+ val = E1_GREEN
+ CALL H5Tenum_insert_f(dtype, "GREEN", val, error)
+ CALL check("h5tenum_insert_f",error, total_error)
+ val = E1_BLUE
+ CALL H5Tenum_insert_f(dtype, "BLUE", val, error)
+ CALL check("h5tenum_insert_f",error, total_error)
+ val = E1_WHITE
+ CALL H5Tenum_insert_f(dtype, "WHITE", val, error)
+ CALL check("h5tenum_insert_f",error, total_error)
+ val = E1_BLACK
+ CALL H5Tenum_insert_f(dtype, "BLACK", val, error)
+ CALL check("h5tenum_insert_f",error, total_error)
+ !
+ ! Create dataspace. Setting maximum size to be the current size.
+ !
+ CALL h5screate_simple_f(1, ds_size, space, error)
+ CALL check("h5screate_simple_f", error, total_error)
+
+ ! ***************************************
+ ! * Dataset of enumeration type
+ ! ***************************************
+ !
+ ! Create a dataset of enum type and write enum data to it
+
+ CALL h5dcreate_f(cwg, "color_table1", dtype, space, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+
+ f_ptr = C_LOC(data1(1))
+ CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
+ CALL check(" h5dwrite_f", error, total_error)
+
+ ! Test reading back the data with no conversion
+
+ f_ptr = C_LOC(data2(1))
+ CALL h5dread_f(dset, dtype, f_ptr, error, space, space)
+ CALL check(" h5dread_f", error, total_error)
+
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. data2(i))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 1. data1(",I0,")=",I0," .NE. data2(",I0,")=",I0)') i, data1(i),i,data2(i)
+ EXIT
+ ENDIF
+ ENDDO
+
+ ! Test converting the data to integer (KIND=C_SHORT). Read enum data back as integer
+ m_baset = h5kind_to_type(KIND(data_short(1)), H5_INTEGER_KIND) ! Memory base type
+ f_ptr = C_LOC(data_short(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. data_short(i))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 2. data1(",I0,")=",I0," .NE. data_short(",I0,")=",I0)') i, data1(i),i,data_short(i)
+ EXIT
+ ENDIF
+ ENDDO
+
+ ! Test converting the data to (KIND=C_double) number.
+ ! Read enum data back as (KIND=C_double) number
+
+ m_baset = h5kind_to_type(KIND(data_double(1)), H5_REAL_KIND) ! Memory base type
+ f_ptr = C_LOC(data_double(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_double(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 3. data_double(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') &
+ i, INT(data1(i)), i, INT(data_double(i))
+ EXIT
+ ENDIF
+ ENDDO
+
+ ! Test converting the data to (SELECTED_INT_KIND(Fortran_INTEGER_4)) number.
+ ! Read enum data back as (SELECTED_INT_KIND(Fortran_INTEGER_4)) number
+
+ m_baset = h5kind_to_type(int_kind_8, H5_INTEGER_KIND) ! Memory base type
+ f_ptr = C_LOC(data_i8(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_i8(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 4. data_i8(",I0,")=",I0," .NE. data_i8(",I0,")=",I0)') &
+ i, INT(data1(i)), i, INT(data_i8(i))
+ EXIT
+ ENDIF
+ ENDDO
+
+ ! Test converting the data to (SELECTED_INT_KIND(Fortran_INTEGER_8)) number.
+ ! Read enum data back as (SELECTED_INT_KIND(Fortran_INTEGER_8)) number
+
+ m_baset = h5kind_to_type(int_kind_16, H5_INTEGER_KIND) ! Memory base type
+ f_ptr = C_LOC(data_i16(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_i16(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 5. data_i16(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') &
+ i, INT(data1(i)), i, INT(data_i16(i))
+ EXIT
+ ENDIF
+ ENDDO
+
+ ! Test converting the data to SELECTED_REAL_KIND(Fortran_REAL_4) number.
+ ! Read enum data back as SELECTED_REAL_KIND(Fortran_REAL_4) number
+
+ m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
+ f_ptr = C_LOC(data_r7(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+ ! Check values
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_r7(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 6. data_r7(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') &
+ i, INT(data1(i)), i, INT(data_r7(i))
+ EXIT
+ ENDIF
+ ENDDO
+
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ ! ***************************************
+ ! * Dataset of C_int type
+ ! ***************************************
+
+ ! Create a integer dataset of KIND=C_INT and write enum data to it
+ m_baset = h5kind_to_type(KIND(data_int(1)), H5_INTEGER_KIND) ! Memory base type
+ CALL h5dcreate_f(cwg, "color_table2", m_baset, space, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+
+ ! Write the enum data
+ f_ptr = C_LOC(data1(1))
+ CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
+ CALL check("h5dwrite_f", error, total_error)
+
+ ! Test reading back the data with no conversion
+ f_ptr = C_LOC(data_int(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. data_int(i))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 7. data1(",I0,")=",I0," .NE. data_int(",I0,")=",I0)') i, data1(i),i,data_int(i)
+ EXIT
+ ENDIF
+ ENDDO
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ !**************************************
+ !* Dataset of C_double type
+ !**************************************
+
+ ! Create a dataset of KIND=C_DOUBLE and write enum data to it
+ m_baset = h5kind_to_type(KIND(data_double(1)), H5_REAL_KIND) ! Memory base type
+ CALL h5dcreate_f(cwg, "color_table3", m_baset, space, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+
+ f_ptr = C_LOC(data1(1))
+ CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
+ CALL check("h5dwrite_f", error, total_error)
+
+ ! Test reading back the data with no conversion
+ f_ptr = C_LOC(data_double(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_double(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 8. data1(",I0,")=",I0," .NE. data_double(",I0,")=",I0)') i, data1(i),i,INT(data_double(i))
+ EXIT
+ ENDIF
+ ENDDO
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ !*********************************************************
+ !* Dataset of real SELECTED_REAL_KIND(Fortran_REAL_4) type
+ !*********************************************************
+
+ ! Create a dataset of SELECTED_REAL_KIND(Fortran_REAL_4) and write enum data to it
+ m_baset = h5kind_to_type(KIND(data_r7(1)), H5_REAL_KIND) ! Memory base type
+ CALL h5dcreate_f(cwg, "color_table4", m_baset, space, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+
+ f_ptr = C_LOC(data1(1))
+ CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
+ CALL check("h5dwrite_f", error, total_error)
+
+ ! Test reading back the data with no conversion
+ f_ptr = C_LOC(data_r7(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. INT(data_r7(i)))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 9. data1(",I0,")=",I0," .NE. data_r7(",I0,")=",I0)') i, data1(i),i,INT(data_r7(i))
+ EXIT
+ ENDIF
+ ENDDO
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ ! *****************************************************************
+ ! * Dataset of integer SELECTED_INT_KIND(Fortran_INTEGER_8) type
+ ! *****************************************************************
+
+ ! Create a integer dataset of (SELECTED_INT_KIND(Fortran_INTEGER_8)) and write enum data to it
+ m_baset = h5kind_to_type(KIND(data_i16(1)), H5_INTEGER_KIND) ! Memory base type
+ CALL h5dcreate_f(cwg, "color_table5", m_baset, space, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+
+ ! Write the enum data
+ f_ptr = C_LOC(data1(1))
+ CALL h5dwrite_f(dset, dtype, f_ptr, error, space, space)
+ CALL check("h5dwrite_f", error, total_error)
+
+ ! Test reading back the data with no conversion
+ f_ptr = C_LOC(data_i16(1))
+ CALL h5dread_f(dset, m_baset, f_ptr, error, space, space)
+ CALL check("h5dread_f", error, total_error)
+
+ DO i = 1, ds_size(1)
+ IF(data1(i) .NE. data_i16(i))THEN
+ total_error = total_error + 1
+ WRITE(*,'(" 10. data1(",I0,")=",I0," .NE. data_i16(",I0,")=",I0)') i, data1(i),i,data_i16(i)
+ EXIT
+ ENDIF
+ ENDDO
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f", error, total_error)
+
+ !
+ ! Close and release resources.
+ !
+ CALL h5sclose_f(space, error)
+ CALL check("H5Sclose_f", error, total_error)
+ CALL h5tclose_f(dtype, error)
+ CALL check("H5Tclose_f", error, total_error)
+ CALL h5gclose_f(cwg, error)
+ CALL check("h5gclose_f",error, total_error)
+ CALL h5fclose_f(file, error)
+ CALL check("H5Fclose_f", error, total_error)
+
+END SUBROUTINE t_enum_conv
+