diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2014-04-12 03:26:21 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2014-04-12 03:26:21 (GMT) |
commit | 19c485a128e4d860a537a14c91e38bc87dc6db25 (patch) | |
tree | 7333e607cf9093aa8020f5a2fa9af159379d845a /fortran/test/tH5MISC_1_8.f90 | |
parent | 33956e594a10ecab24867ab0c3347452f22b4e11 (diff) | |
download | hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.zip hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.gz hdf5-19c485a128e4d860a537a14c91e38bc87dc6db25.tar.bz2 |
[svn-r25027] Merged changes from the trunk to the branch,
svn merge -r24929:25009 https://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran
tested: jam (gnu)
Diffstat (limited to 'fortran/test/tH5MISC_1_8.f90')
-rw-r--r-- | fortran/test/tH5MISC_1_8.f90 | 474 |
1 files changed, 474 insertions, 0 deletions
diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90 new file mode 100644 index 0000000..bb7d50a --- /dev/null +++ b/fortran/test/tH5MISC_1_8.f90 @@ -0,0 +1,474 @@ +!****h* root/fortran/test/tH5MISC_1_8.f90 +! +! NAME +! tH5MISC_1_8.f90 +! +! FUNCTION +! Basic testing of Fortran API's introduced in 1.8 release. +! +! COPYRIGHT +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +!***** +MODULE TH5MISC_1_8 + +CONTAINS + +SUBROUTINE dtransform(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: dxpl_id_c_to_f + INTEGER(HID_T) :: file_id + + CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123" + INTEGER :: error + CHARACTER(LEN=15) :: ptrgetTest + CHARACTER(LEN=7) :: ptrgetTest_small + CHARACTER(LEN=30) :: ptrgetTest_big + + INTEGER(SIZE_T) :: size + + CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error) + CALL check("dtransform.H5Fcreate_f", error, total_error) + + CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error) + CALL check("dtransform.H5Pcreate_f", error, total_error) + + CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error) + CALL check("dtransform.H5Pset_data_transform_f", error, total_error) + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error) + +! check case when receiving buffer to small + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error) + +! check case when receiving buffer to big + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + +END SUBROUTINE dtransform + + +!/**************************************************************** +!** +!** test_genprop_basic_class(): Test basic generic property list code. +!** Tests creating new generic classes. +!** +!****************************************************************/ + +SUBROUTINE test_genprop_basic_class(cleanup, total_error) + + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: cid1 !/* Generic Property class ID */ + INTEGER(HID_T) :: cid2 !/* Generic Property class ID */ + + CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" + CHARACTER(LEN=7) :: name ! /* Name of class */ + CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */ + CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/ + INTEGER :: error + INTEGER :: size + LOGICAL :: flag + + !/* Output message about test being performed */ + + !WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality" + + ! Try some bogus value for class identifier; function should fail gracefully + + cid1 = 456 + CALL H5Pget_class_name_f(cid1, name, size, error) + CALL VERIFY("H5Pget_class_name", error, -1, error) + + ! /* Create a new generic class, derived from the root of the class hierarchy */ + CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error) + CALL check("H5Pcreate_class", error, total_error) + + ! /* Check class name */ + CALL H5Pget_class_name_f(cid1, name, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME + total_error = total_error + 1 + ENDIF + + ! /* Check class name smaller buffer*/ + CALL H5Pget_class_name_f(cid1, name_small, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4) + total_error = total_error + 1 + ENDIF + + ! /* Check class name bigger buffer*/ + CALL H5Pget_class_name_f(cid1, name_big, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME) + total_error = total_error + 1 + ENDIF + + ! /* Check class parent */ + CALL H5Pget_class_parent_f(cid1, cid2, error) + CALL check("H5Pget_class_parent_f", error, total_error) + + ! /* Verify class parent correct */ + CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error) + CALL check("H5Pequal_f", error, total_error) + CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error) + + + ! /* Make certain false postives aren't being returned */ + CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error) + CALL check("H5Pequal_f", error, total_error) + CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error) + + !/* Close parent class */ + CALL H5Pclose_class_f(cid2, error) + CALL check("H5Pclose_class_f", error, total_error) + + + !/* Close class */ + CALL H5Pclose_class_f(cid1, error) + CALL check("H5Pclose_class_f", error, total_error) + +END SUBROUTINE test_genprop_basic_class + +SUBROUTINE test_h5s_encode(cleanup, total_error) + +!/**************************************************************** +!** +!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding. +!** +!****************************************************************/ + + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */ + INTEGER(hid_t) :: decoded_sid1, decoded_sid3 + INTEGER :: rank !/* LOGICAL rank of dataspace */ + INTEGER(size_t) :: sbuf_size=0, scalar_size=0 + +! Make sure the size is large + CHARACTER(LEN=288) :: sbuf + CHARACTER(LEN=288) :: scalar_buf + + INTEGER(hsize_t) :: n ! /* Number of dataspace elements */ + + INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/) + INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/) + INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/) + INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/) + + INTEGER :: space_type + ! + ! Dataset dimensions + ! + INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13 + + INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) + INTEGER :: SPACE1_RANK = 3 + INTEGER :: error + + !/*------------------------------------------------------------------------- + ! * Test encoding and decoding of simple dataspace and hyperslab selection. + ! *------------------------------------------------------------------------- + ! */ + + CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) + CALL check("H5Screate_simple", error, total_error) + + CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, & + start, count, error, stride=stride, BLOCK=BLOCK) + CALL check("h5sselect_hyperslab_f", error, total_error) + + + !/* Encode simple data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + + ! /* Try decoding bogus buffer */ + + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL VERIFY("H5Sdecode", error, -1, total_error) + + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + ! /* Decode from the dataspace buffer and return an object handle */ + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL check("H5Sdecode", error, total_error) + + + ! /* Verify the decoded dataspace */ + CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error) + CALL check("h5sget_simple_extent_npoints_f", error, total_error) + CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, & + total_error) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(sid1, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid1, error) + CALL check("h5sclose_f", error, total_error) + + ! /*------------------------------------------------------------------------- + ! * Test encoding and decoding of scalar dataspace. + ! *------------------------------------------------------------------------- + ! */ + ! /* Create scalar dataspace */ + + CALL H5Screate_f(H5S_SCALAR_F, sid3, error) + CALL check("H5Screate_f",error, total_error) + + ! /* Encode scalar data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + ! encode + + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + + ! /* Decode from the dataspace buffer and return an object handle */ + + CALL H5Sdecode_f(scalar_buf, decoded_sid3, error) + CALL check("H5Sdecode_f", error, total_error) + + + ! /* Verify extent type */ + + CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error) + CALL check("H5Sget_simple_extent_type_f", error, total_error) + CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error) + + ! /* Verify decoded dataspace */ + CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error) + CALL check("h5sget_simple_extent_npoints_f", error, total_error) + CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error) + + CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error) + CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error) + CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error ) + + CALL h5sclose_f(sid3, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid3, error) + CALL check("h5sclose_f", error, total_error) + +END SUBROUTINE test_h5s_encode + +!------------------------------------------------------------------------- +! Function: test_scaleoffset +! +! Purpose: Tests the integer datatype for scaleoffset filter +! with fill value set +! +! Return: Success: 0 +! Failure: >0 +! +! Programmer: M. Scot Breitenfeld +! Decemeber 11, 2010 +! +! Modifications: +! +!------------------------------------------------------------------------- +! + +SUBROUTINE test_scaleoffset(cleanup, total_error ) + + USE HDF5 + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(hid_t) :: file + + INTEGER(hid_t) :: dataset, datatype, space, mspace, dc + INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2, 5/) + INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2, 5/) + INTEGER, DIMENSION(1:2,1:5) :: orig_data + INTEGER, DIMENSION(1:2,1:5) :: new_data + INTEGER(hsize_t), DIMENSION(1:2) :: start ! Start of hyperslab + INTEGER(hsize_t), DIMENSION(1:2) :: stride ! Stride of hyperslab + INTEGER(hsize_t), DIMENSION(1:2) :: count ! BLOCK count + INTEGER(hsize_t), DIMENSION(1:2) :: BLOCK ! BLOCK sizes + INTEGER :: fillval + INTEGER(size_t) :: j + REAL :: x + INTEGER :: error + LOGICAL :: status + + ! check to see if filter is available + CALL H5Zfilter_avail_f(H5Z_FILTER_SCALEOFFSET_F, status, error) + IF(.NOT.status)THEN ! We don't have H5Z_FILTER_SCALEOFFSET_F filter + total_error = -1 ! so return + RETURN + ENDIF + + CALL H5Fcreate_f("h5scaleoffset.h5", H5F_ACC_TRUNC_F, file, error) + CALL check("H5Fcreate_f", error, total_error) + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, datatype, error) + CALL CHECK(" H5Tcopy_f", error, total_error) + + ! Set order of dataset datatype + CALL H5Tset_order_f(datatype, H5T_ORDER_BE_F, error) + CALL CHECK(" H5Tset_order_f", error, total_error) + + ! Create the data space for the dataset + CALL H5Screate_simple_f(2, dims, space, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! Create the dataset property list + CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error) + CALL CHECK(" H5Pcreate_f", error, total_error) + + ! Set fill value + fillval = 10000 + CALL H5Pset_fill_value_f(dc, H5T_NATIVE_INTEGER, fillval, error) + CALL CHECK(" H5Pset_fill_value_f", error, total_error) + + ! Set up to use scaleoffset filter, let library calculate minbits + CALL H5Pset_chunk_f(dc, 2, chunk_dim, error) + CALL CHECK(" H5Pset_chunk_f", error, total_error) + + CALL H5Pset_scaleoffset_f(dc, H5Z_SO_INT_F, H5Z_SO_INT_MINBITS_DEFAULT_F, error) + CALL CHECK(" H5Pset_scaleoffset_f", error, total_error) + + ! Create the dataset + CALL H5Dcreate_f(file, "scaleoffset_int", datatype, & + space, dataset, error, dc) + CALL CHECK(" H5Dcreate_f", error, total_error) + + ! Create the memory data space + CALL H5Screate_simple_f(2, dims, mspace, error) + CALL CHECK(" H5Screate_simple_f", error, total_error) + + ! Select hyperslab for data to write, using 1x5 blocks, + ! (1,1) stride and (1,1) count starting at the position (0,0) + + start(1:2) = (/0,0/) + stride(1:2) = (/1,1/) + COUNT(1:2) = (/1,1/) + BLOCK(1:2) = (/1,5/) + + CALL H5Sselect_hyperslab_f(mspace, H5S_SELECT_SET_F, start, & + count, error, stride, BLOCK) + CALL CHECK(" H5Sselect_hyperslab_f", error, total_error) + + CALL RANDOM_SEED() + ! Initialize data of hyperslab + DO j = 1, INT(dims(2)) + CALL RANDOM_NUMBER(x) + orig_data(1,j) = INT(x*10000.) + IF(MOD(j,2_size_t).EQ.0)THEN + orig_data(1,j) = - orig_data(1,j) + ENDIF + ENDDO + + !---------------------------------------------------------------------- + ! STEP 1: Test scaleoffset by setting up a chunked dataset and writing + ! to it. + !---------------------------------------------------------------------- + + ! Only data in the hyperslab will be written, other value should be fill value + CALL H5Dwrite_f(dataset, H5T_NATIVE_INTEGER, orig_data, dims, error, mspace, mspace, H5P_DEFAULT_F) + CALL CHECK(" H5Dwrite_f", error, total_error) + + !---------------------------------------------------------------------- + ! STEP 2: Try to read the data we just wrote. + !---------------------------------------------------------------------- + + ! Read the dataset back + + CALL H5Dread_f(dataset, H5T_NATIVE_INTEGER, new_data, dims, error, mspace, mspace, H5P_DEFAULT_F) + CALL CHECK(" H5Dread_f", error, total_error) + + ! Check that the values read are the same as the values written + DO j = 1, INT(dims(2)) + IF(new_data(1,j) .NE. orig_data(1,j))THEN + total_error = total_error + 1 + WRITE(*,'(" Read different values than written.")') + WRITE(*,'(" At index ", 2(1X,I0))') 1, j + EXIT + ENDIF + ENDDO + !---------------------------------------------------------------------- + ! Cleanup + !---------------------------------------------------------------------- + CALL H5Tclose_f(datatype, error) + CALL CHECK(" H5Tclose_f", error, total_error) + CALL H5Pclose_f(dc, error) + CALL CHECK(" H5Pclose_f", error, total_error) + CALL H5Sclose_f(space, error) + CALL CHECK(" H5Sclose_f", error, total_error) + CALL H5Dclose_f(dataset, error) + CALL CHECK(" H5Dclose_f", error, total_error) + CALL H5Fclose_f(file, error) + CALL CHECK(" H5Fclose_f", error, total_error) + +END SUBROUTINE test_scaleoffset + +END MODULE TH5MISC_1_8 |