summaryrefslogtreecommitdiffstats
path: root/fortran/test/tH5T_F03.f90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2011-08-31 03:02:41 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2011-08-31 03:02:41 (GMT)
commit2f282ffa9ddd0115e37b465463a104c49299fa33 (patch)
tree9cad54b4b5f288ea34ea9eb34c612f376a19a109 /fortran/test/tH5T_F03.f90
parent857bb0f9e24c166c7420d9ddcdcc77da19348a2d (diff)
downloadhdf5-2f282ffa9ddd0115e37b465463a104c49299fa33.zip
hdf5-2f282ffa9ddd0115e37b465463a104c49299fa33.tar.gz
hdf5-2f282ffa9ddd0115e37b465463a104c49299fa33.tar.bz2
[svn-r21339] Description: Added test for reading and writing vl strings in fortran (using F2003), for both 1D and 2D array of vl strings.
Tested: jam (pgi, gfortran 4.5, ifort) linew (12.3 beta)
Diffstat (limited to 'fortran/test/tH5T_F03.f90')
-rw-r--r--fortran/test/tH5T_F03.f90253
1 files changed, 252 insertions, 1 deletions
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index 1d6d8de..f7cbd15 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -2422,6 +2422,257 @@ SUBROUTINE t_vlstring(total_error)
END SUBROUTINE t_vlstring
+SUBROUTINE t_vlstring_readwrite(total_error)
+
+! test writing and reading vl string using h5dread_f and h5dwrite_f, C_LOC and C_F_POINTER
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ CHARACTER(LEN=19), PARAMETER :: filename = "t_vlstringrw_F03.h5"
+ CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1"
+ CHARACTER(LEN=3) , PARAMETER :: dataset2D = "DS2"
+
+ INTEGER(HSIZE_T) , PARAMETER :: dim0 = 4
+ INTEGER(HSIZE_T) , PARAMETER :: dim1 = 2
+ INTEGER(SIZE_T) , PARAMETER :: sdim = 7
+ INTEGER(HID_T) :: file, filetype, space, dset ! Handles
+ INTEGER(HSIZE_T), DIMENSION(1:1) :: dims = (/dim0/)
+ INTEGER(HSIZE_T), DIMENSION(1:2) :: dims2D = (/dim1,dim0/)
+ INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims
+
+ TYPE(C_PTR), DIMENSION(1:dim0), TARGET :: wdata
+ CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A = "123456"//C_NULL_CHAR
+ CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: B = "7890"//C_NULL_CHAR
+ CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: C = "abc"//C_NULL_CHAR
+ CHARACTER(len=3, KIND=c_char), DIMENSION(1:1), TARGET :: D = "df"//C_NULL_CHAR
+
+ TYPE(C_PTR), DIMENSION(1:dim1,1:dim0), TARGET :: wdata2D
+
+ CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A11 = "A(1,1)"//C_NULL_CHAR
+ CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: A12 = "A12"//C_NULL_CHAR
+ CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: A13 = "A_13"//C_NULL_CHAR
+ CHARACTER(len=8, KIND=c_char), DIMENSION(1:1), TARGET :: A14 = "A_{1,4}"//C_NULL_CHAR
+ CHARACTER(len=8, KIND=c_char), DIMENSION(1:1), TARGET :: A21 = "A_{2,1}"//C_NULL_CHAR
+ CHARACTER(len=5, KIND=c_char), DIMENSION(1:1), TARGET :: A22 = "A_22"//C_NULL_CHAR
+ CHARACTER(len=4, KIND=c_char), DIMENSION(1:1), TARGET :: A23 = "A23"//C_NULL_CHAR
+ CHARACTER(len=7, KIND=c_char), DIMENSION(1:1), TARGET :: A24 = "A(2,4)"//C_NULL_CHAR
+
+ TYPE(C_PTR), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
+ TYPE(C_PTR), DIMENSION(:,:), ALLOCATABLE, TARGET :: rdata2D ! Read 2D buffer
+ CHARACTER(len=8, kind=c_char), POINTER :: data ! A pointer to a Fortran string
+ CHARACTER(len=8, kind=c_char), DIMENSION(1:4) :: data_w ! A pointer to a Fortran string
+ CHARACTER(len=8, kind=c_char), DIMENSION(1:dim1,1:dim0) :: data2D_w ! A pointer to a Fortran string
+ TYPE(C_PTR) :: f_ptr
+ INTEGER :: i, j, len
+ INTEGER :: error
+
+ ! Initialize array of C pointers
+
+ wdata(1) = C_LOC(A(1))
+ wdata(2) = C_LOC(B(1))
+ wdata(3) = C_LOC(C(1))
+ wdata(4) = C_LOC(D(1))
+
+ data_w(1) = A(1)
+ data_w(2) = B(1)
+ data_w(3) = C(1)
+ data_w(4) = D(1)
+
+ wdata2D(1,1) = C_LOC(A11(1))
+ wdata2D(1,2) = C_LOC(A12(1))
+ wdata2D(1,3) = C_LOC(A13(1))
+ wdata2D(1,4) = C_LOC(A14(1))
+ wdata2D(2,1) = C_LOC(A21(1))
+ wdata2D(2,2) = C_LOC(A22(1))
+ wdata2D(2,3) = C_LOC(A23(1))
+ wdata2D(2,4) = C_LOC(A24(1))
+
+ data2D_w(1,1) = A11(1)
+ data2D_w(1,2) = A12(1)
+ data2D_w(1,3) = A13(1)
+ data2D_w(1,4) = A14(1)
+ data2D_w(2,1) = A21(1)
+ data2D_w(2,2) = A22(1)
+ data2D_w(2,3) = A23(1)
+ data2D_w(2,4) = A24(1)
+
+ !
+ ! Create a new file using the default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file, error)
+ CALL check("h5fcreate_f",error, total_error)
+ !
+ ! Create file and memory datatypes. For this test we will save
+ ! the strings as C variable length strings, H5T_STRING is defined
+ ! as a variable length string.
+ !
+ CALL H5Tcopy_f(H5T_STRING, filetype, error)
+ CALL check("H5Tcopy_f",error, total_error)
+ !
+ ! Create dataspace.
+ !
+ CALL h5screate_simple_f(1, dims, space, error)
+ CALL check("h5screate_simple_f",error, total_error)
+ !
+ ! Create the dataset and write the variable-length string data to
+ ! it.
+ !
+ CALL h5dcreate_f(file, dataset, filetype, space, dset, error)
+ CALL check("h5dcreate_f",error, total_error)
+
+ f_ptr = C_LOC(wdata(1))
+ CALL h5dwrite_f(dset, filetype, f_ptr, error)
+ CALL check("h5dwrite_f",error, total_error)
+
+ !
+ ! Close and release resources.
+ !
+ CALL h5dclose_f(dset , error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5sclose_f(space, error)
+ CALL check("h5sclose_f",error, total_error)
+
+ !
+ ! Create dataspace.
+ !
+ CALL h5screate_simple_f(2, dims2D, space, error)
+ CALL check("h5screate_simple_f",error, total_error)
+ !
+ ! Create the dataset and write the variable-length string data to
+ ! it.
+ !
+ CALL h5dcreate_f(file, dataset2D, filetype, space, dset, error)
+ CALL check("h5dcreate_f",error, total_error)
+
+ f_ptr = C_LOC(wdata2D(1,1))
+ CALL h5dwrite_f(dset, filetype, f_ptr, error)
+ CALL check("h5dwrite_f",error, total_error)
+
+ !
+ ! Close and release resources.
+ !
+ CALL h5dclose_f(dset , error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5sclose_f(space, error)
+ CALL check("h5sclose_f",error, total_error)
+
+ CALL H5Tclose_f(filetype, error)
+ CALL check("h5tclose_f",error, total_error)
+ CALL h5fclose_f(file , error)
+ CALL check("h5fclose_f",error, total_error)
+
+ !
+ ! Now we begin the read section of this test.
+ !
+ !
+ ! Open file and dataset.
+ !
+ CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file, error)
+ CALL check("h5fopen_f",error, total_error)
+ CALL h5dopen_f(file, dataset, dset, error)
+ CALL check("h5dopen_f",error, total_error)
+ !
+ ! Get the datatype.
+ !
+ CALL H5Dget_type_f(dset, filetype, error)
+ CALL check("H5Dget_type_f",error, total_error)
+ !
+ ! Get dataspace and allocate memory for read buffer.
+ !
+ CALL H5Dget_space_f(dset, space, error)
+ CALL check("H5Dget_space_f",error, total_error)
+
+ CALL H5Sget_simple_extent_dims_f(space, dims, maxdims, error)
+ CALL check("H5Sget_simple_extent_dims_f",error, total_error)
+ ALLOCATE(rdata(1:dims(1)))
+ !
+ ! Read the data.
+ !
+
+ f_ptr = C_LOC(rdata(1))
+ CALL h5dread_f(dset, H5T_STRING, f_ptr, error)
+ CALL check("H5Dread_f",error, total_error)
+
+ !
+ ! Check the data.
+ !
+ DO i = 1, dims(1)
+ CALL C_F_POINTER(rdata(i), data)
+ len = 0
+ DO
+ IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
+ len = len + 1
+ ENDDO
+ CALL verifystring("h5dread_f",data(1:len), data_w(i)(1:len), total_error)
+ END DO
+
+ DEALLOCATE(rdata)
+ CALL h5dclose_f(dset , error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5sclose_f(space, error)
+ CALL check("h5sclose_f",error, total_error)
+ !
+ ! Test reading in 2D dataset
+ !
+ CALL h5dopen_f(file, dataset2D, dset, error)
+ CALL check("h5dopen_f",error, total_error)
+ !
+ ! Get the datatype.
+ !
+ CALL H5Dget_type_f(dset, filetype, error)
+ CALL check("H5Dget_type_f",error, total_error)
+ !
+ ! Get dataspace and allocate memory for read buffer.
+ !
+ CALL H5Dget_space_f(dset, space, error)
+ CALL check("H5Dget_space_f",error, total_error)
+
+
+ CALL H5Sget_simple_extent_dims_f(space, dims2D, maxdims, error)
+ CALL check("H5Sget_simple_extent_dims_f",error, total_error)
+ ALLOCATE(rdata2D(1:dims2D(1),1:dims2D(2)))
+
+ !
+ ! Read the data.
+ !
+
+ f_ptr = C_LOC(rdata2D(1,1))
+ CALL h5dread_f(dset, H5T_STRING, f_ptr, error)
+ CALL check("H5Dread_f",error, total_error)
+
+ !
+ ! Check the data.
+ !
+ DO i = 1, dims2D(1)
+ DO j = 1, dims2D(2)
+ CALL C_F_POINTER(rdata2D(i,j), DATA)
+ len = 0
+ DO
+ IF(DATA(len+1:len+1).EQ.C_NULL_CHAR.OR.len.GE.8) EXIT
+ len = len + 1
+ ENDDO
+ CALL verifystring("h5dread_f",DATA(1:len), data2D_w(i,j)(1:len), total_error)
+ ENDDO
+ END DO
+
+ DEALLOCATE(rdata2D)
+ CALL h5dclose_f(dset , error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5sclose_f(space, error)
+ CALL check("h5sclose_f",error, total_error)
+
+ CALL H5Tclose_f(filetype, error)
+ CALL check("h5tclose_f",error, total_error)
+ CALL h5fclose_f(file , error)
+ CALL check("h5fclose_f",error, total_error)
+
+END SUBROUTINE t_vlstring_readwrite
+
SUBROUTINE t_string(total_error)
@@ -2529,7 +2780,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dread_f",error, total_error)
DO i = 1, dims(1)
- CALL verifystring("h5dopen_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
+ CALL verifystring("h5dread_f",TRIM(rdata(i)),TRIM(wdata(i)) , total_error)
END DO
DEALLOCATE(rdata)