diff options
Diffstat (limited to 'fortran/test/fortranlib_test_1_8.f90')
| -rw-r--r-- | fortran/test/fortranlib_test_1_8.f90 | 453 |
1 files changed, 6 insertions, 447 deletions
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 index dc45560..039dc6c 100644 --- a/fortran/test/fortranlib_test_1_8.f90 +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -27,7 +27,8 @@ PROGRAM fortranlibtest USE HDF5 - + USE THDF5_1_8 + USE TH5_MISC IMPLICIT NONE INTEGER :: total_error = 0 INTEGER :: error @@ -57,10 +58,10 @@ PROGRAM fortranlibtest ENDIF WRITE(*,*) - ret_total_error = 0 - CALL file_space("file_space_1_8",cleanup, ret_total_error) - CALL write_test_status(ret_total_error, & - ' Testing file free space', & + CALL h5eset_auto_f(0, ret_total_error) + IF(ret_total_error.NE.0) & + CALL write_test_status(ret_total_error, & + ' h5eset_auto_f', & total_error) ret_total_error = 0 @@ -113,445 +114,3 @@ PROGRAM fortranlibtest IF (total_error .NE. 0) CALL h5_exit_f (1) END PROGRAM fortranlibtest - -SUBROUTINE dtransform(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - - 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 - - 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 - - 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 - - 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, 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, 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 |