diff options
| author | Bill Wendling <wendling@ncsa.uiuc.edu> | 2000-09-19 20:06:49 (GMT) |
|---|---|---|
| committer | Bill Wendling <wendling@ncsa.uiuc.edu> | 2000-09-19 20:06:49 (GMT) |
| commit | 8055378bcecfc77af85b2bb07e7904edc9492789 (patch) | |
| tree | 01c100c34cd727b9dc15ae21c89b6e0dfa361303 /fortran/test | |
| parent | 8272da0b67a9ef3a7299fd10cc5f3ccbf80cbeae (diff) | |
| download | hdf5-8055378bcecfc77af85b2bb07e7904edc9492789.zip hdf5-8055378bcecfc77af85b2bb07e7904edc9492789.tar.gz hdf5-8055378bcecfc77af85b2bb07e7904edc9492789.tar.bz2 | |
[svn-r2576] Purpose:
Adding the Fortran interface to the HDF5 library
Description:
Fortran is now a subdirectory of the HDF5 library tree.
Platforms tested:
Solaris and IRIX (O2K)
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/Dependencies | 0 | ||||
| -rw-r--r-- | fortran/test/Makefile.in | 40 | ||||
| -rw-r--r-- | fortran/test/fflush1.f90 | 128 | ||||
| -rw-r--r-- | fortran/test/fflush2.f90 | 158 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.f90 | 169 | ||||
| -rw-r--r-- | fortran/test/hdf5test.f90 | 16 | ||||
| -rw-r--r-- | fortran/test/tH5D.f90 | 452 | ||||
| -rw-r--r-- | fortran/test/tH5F.f90 | 516 | ||||
| -rw-r--r-- | fortran/test/tH5P.f90 | 101 | ||||
| -rw-r--r-- | fortran/test/tH5R.f90 | 367 | ||||
| -rw-r--r-- | fortran/test/tH5S.f90 | 247 | ||||
| -rw-r--r-- | fortran/test/tH5Sselect.f90 | 991 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 691 |
13 files changed, 3876 insertions, 0 deletions
diff --git a/fortran/test/Dependencies b/fortran/test/Dependencies new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/fortran/test/Dependencies diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in new file mode 100644 index 0000000..59a56e6 --- /dev/null +++ b/fortran/test/Makefile.in @@ -0,0 +1,40 @@ +## HDF5-Fortran test/Makefile(.in) +## +## Copyright (C) 2000 National Center for Supercomputing Applications. +## All rights reserved. +## +## +top_srcdir=@top_srcdir@ +top_builddir=.. +srcdir=@srcdir@ +@COMMENCE@ + +hdf5_dir=$(top_srcdir)/../src + +## Add include directory to the C preprocessor flags and the h5test and hdf5 +## libraries to the library list. +LT_LINK_LIB=$(LT) --mode=link $(F9X) -static -rpath $(libdir) +MFLAG=@F9XMODFLAG@ +FFLAGS=$(MFLAG). $(MFLAG)../src +FLIB=../src/libhdf5_fortran.la +HDF5LIB=$(hdf5_dir)/libhdf5.la + +TEST_PROGS_SRC=fortranlib_test.f90 fflush1.f90 fflush2.f90 +TEST_PROGS=$(TEST_PROGS_SRC:.f90=) + +TEST_SRC=hdf5test.f90 tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 \ + tH5Sselect.f90 tH5P.f90 +TEST_OBJ=$(TEST_SRC:.f90=.lo) + +$(TEST_PROGS): $(FLIB) + +fortranlib_test: $(TEST_OBJ) + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ fortranlib_test.f90 $(TEST_OBJ) $(FLIB) $(LIBS) $(HDF5LIB) + +fflush1: fflush1.f90 hdf5test.f90 + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ fflush1.f90 hdf5test.o $(FLIB) $(LIBS) $(HDF5LIB) + +fflush2: fflush2.f90 hdf5test.f90 + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ fflush2.f90 hdf5test.o $(FLIB) $(LIBS) $(HDF5LIB) + +@CONCLUDE@ diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90 new file mode 100644 index 0000000..8aee1b6 --- /dev/null +++ b/fortran/test/fflush1.f90 @@ -0,0 +1,128 @@ + ! + ! Purpose: This is the first half of a two-part test that makes sure + ! that a file can be read after an application crashes as long + ! as the file was flushed first. We simulate by exit the + ! the program using stop statement + ! + + PROGRAM FFLUSH1EXAMPLE + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + + ! + !the respective filename is "fflush1.h5" + ! + CHARACTER(LEN=10), PARAMETER :: filename = "fflush1.h5" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 + + ! + ! File identifiers + ! + INTEGER(HID_T) :: file_id + + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid + + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j, total_error = 0 + + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out + + ! + !Initialize FORTRAN predifined datatypes + ! + CALL h5init_types_f(error) + CALL check("h5init_types_f",error,total_error) + + ! + !Initialize data_in buffer + ! + do i = 1, NX + do j = 1, NY + data_in(i,j) = (i-1) + (j-1) + end do + end do + + ! + !Create file "fflush1.h5" using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create group "/G" inside file "fflush1.h5". + ! + CALL h5gcreate_f(file_id, "/G", gid, error) + CALL check("h5gcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/D" inside file "fflush1.h5". + ! + CALL h5dcreate_f(file_id, "/D", H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !flush and exit without closing the library + ! + CALL H5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) + CALL check("h5fflush_f",error,total_error) + + + 001 STOP + + + END PROGRAM FFLUSH1EXAMPLE + diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90 new file mode 100644 index 0000000..a0a076f --- /dev/null +++ b/fortran/test/fflush2.f90 @@ -0,0 +1,158 @@ + ! + ! Purpose: This is the second half of a two-part test that makes sure + ! that a file can be read after an application crashes as long + ! as the file was flushed first. This half tries to read the + ! file created by the first half. + ! + + PROGRAM FFLUSH2EXAMPLE + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + + ! + !the respective filename is "fflush1.h5" + ! + CHARACTER(LEN=10), PARAMETER :: filename = "fflush1.h5" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 + + ! + ! File identifiers + ! + INTEGER(HID_T) :: file_id + + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid + + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j, total_error = 0 + + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_out + + ! + !Initialize FORTRAN predifined datatypes + ! + CALL h5init_types_f(error) + CALL check("h5init_types_f",error,total_error) + + ! + !Open the file. + ! + CALL h5fopen_f(filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !Open the dataset + ! + CALL h5dopen_f(file_id, "/D", dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's data type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, dtype_id, data_out, error) + CALL check("h5dread_f",error,total_error) + + ! + !Print the dataset. + ! + do i = 1, NX + write(*,*) (data_out(i,j), j = 1, NY) + end do +! +!result of the print statement +! +! 0, 1, 2, 3, 4 +! 1, 2, 3, 4, 5 +! 2, 3, 4, 5, 6 +! 3, 4, 5, 6, 7 + + ! + !Open the group. + ! + CALL h5gopen_f(file_id, "G", gid, error) + CALL check("h5gopen_f",error,total_error) + + ! + !In case error happens, jump to stop. + ! + IF (error == -1) THEN + 001 STOP + END IF + + ! + !Close the datatype + ! + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the group. + ! + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Close FORTRAN predifined datatypes + ! + CALL h5close_types_f(error) + CALL check("h5close_types_f",error,total_error) + + END PROGRAM FFLUSH2EXAMPLE diff --git a/fortran/test/fortranlib_test.f90 b/fortran/test/fortranlib_test.f90 new file mode 100644 index 0000000..40c323b --- /dev/null +++ b/fortran/test/fortranlib_test.f90 @@ -0,0 +1,169 @@ +! +! +! Testing Fortran functionality. +! + PROGRAM fortranlibtest + + !USE H5FTEST + !USE H5DTEST + !USE H5RTEST + !USE H5STEST + USE HDF5 + + IMPLICIT NONE + INTEGER :: total_error = 0 + INTEGER :: error + INTEGER :: mounting_total_error = 0 + INTEGER :: reopen_total_error = 0 + INTEGER :: dataset_total_error = 0 + INTEGER :: extend_dataset_total_error = 0 + INTEGER :: refobj_total_error = 0 + INTEGER :: refreg_total_error = 0 + INTEGER :: dataspace_total_error = 0 + INTEGER :: hyperslab_total_error = 0 + INTEGER :: element_total_error = 0 + INTEGER :: basic_select_total_error = 0 + INTEGER :: total_error_compoundtest = 0 + INTEGER :: basic_datatype_total_error = 0 + INTEGER :: external_total_error = 0 + + CALL h5init_types_f(error) + write(*,*) + write(*,*) "Testing File Interface" + + CALL mountingtest(mounting_total_error) + IF (mounting_total_error == 0) THEN + write(*,*) "mounting test OK" + ELSE + write(*,*) "mounting test FAILED" + END IF + total_error = total_error + mounting_total_error + + CALL reopentest(reopen_total_error) + IF (reopen_total_error == 0) THEN + write(*,*) "Reopen test OK" + ELSE + write(*,*) "Reopen test FAILED" + END IF + total_error = total_error + reopen_total_error + + + + write(*,*) + write(*,*) "Testing Dataset Interface" + + CALL datasettest(dataset_total_error) + IF (dataset_total_error == 0) THEN + write(*,*) "dataset test OK" + ELSE + write(*,*) "dataset test FAILED" + END IF + total_error = total_error + dataset_total_error + + CALL extenddsettest(extend_dataset_total_error) + IF (extend_dataset_total_error == 0) THEN + write(*,*) "extend dataset test OK" + ELSE + write(*,*) "extend dataset test FAILED" + END IF + total_error = total_error + extend_dataset_total_error + + write(*,*) + write(*,*) "Testing DATASPACE Interface" + + CALL dataspace_basic_test(dataspace_total_error) + IF (dataspace_total_error == 0) THEN + write(*,*) "dataspce basic test OK" + ELSE + write(*,*) "dataspace basic test FAILED" + END IF + total_error = total_error + dataspace_total_error + + + write(*,*) + write(*,*) "Testing Reference Interface" + + CALL refobjtest(refobj_total_error) + IF (refobj_total_error == 0) THEN + write(*,*) "Reference to object test OK" + ELSE + write(*,*) "Reference to object test FAILED" + END IF + total_error = total_error + refobj_total_error + + CALL refregtest(refreg_total_error) + IF (refreg_total_error == 0) THEN + write(*,*) "Refernce to Region test OK" + ELSE + write(*,*) "Refernce to Region test FAILED" + END IF + total_error = total_error + refreg_total_error + + write(*,*) + write(*,*) "Testing selection functionalities" + + CALL test_select_hyperslab( hyperslab_total_error) + IF ( hyperslab_total_error == 0) THEN + write(*,*) "hyperslab selection test OK" + ELSE + write(*,*) "hyperslab selection test FAILED" + END IF + total_error = total_error + hyperslab_total_error + + CALL test_select_element(element_total_error) + IF (element_total_error == 0) THEN + write(*,*) "element selection test OK" + ELSE + write(*,*) "element selection test FAILED" + END IF + total_error = total_error + element_total_error + + CALL test_basic_select(basic_select_total_error) + IF (basic_select_total_error == 0) THEN + write(*,*) "basic selection test OK" + ELSE + write(*,*) "basic selection test FAILED" + END IF + total_error = total_error + basic_select_total_error + write(*,*) + + write(*,*) "Testing Compound Datatypes" + CALL compoundtest(total_error_compoundtest) + IF (total_error_compoundtest == 0) THEN + write(*,*) "Compound Datatype test OK" + ELSE + write(*,*) "Compound Datatype test FAILED" + END IF + total_error = total_error + total_error_compoundtest + + write(*,*) + write(*,*) "Testing basic datatype functionalities" + CALL basic_data_type_test(basic_datatype_total_error) + IF (basic_datatype_total_error == 0) THEN + write(*,*) "Basic Datatype test OK" + ELSE + write(*,*) "Basic Datatype test FAILED" + END IF + total_error = total_error + basic_datatype_total_error + + write(*,*) + write(*,*) "Testing external functionalities" + CALL external_test(external_total_error) + IF (external_total_error == 0) THEN + write(*,*) "External test OK" + ELSE + write(*,*) "External test FAILED" + END IF + total_error = total_error + external_total_error + + write(*,*) + + if (total_error .eq. 0) write(*,*) "Fortran_lib test passed!" + if (total_error.gt. 0) write(*,*) "Fortran_lib test failed with ",& + total_error, " error(s)" + + CALL h5close_types_f(error) + + END PROGRAM fortranlibtest + + diff --git a/fortran/test/hdf5test.f90 b/fortran/test/hdf5test.f90 new file mode 100644 index 0000000..978c832 --- /dev/null +++ b/fortran/test/hdf5test.f90 @@ -0,0 +1,16 @@ +! +! +! This module contains check subroutine which is used in +! all the fortran h5 test files +! + + SUBROUTINE check(string,error,total_error) + CHARACTER(LEN=*) :: string + INTEGER :: error, total_error + if (error .lt. 0) then + total_error=total_error+1 + write(*,*) string, " failed" + endif + RETURN + END SUBROUTINE check + diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90 new file mode 100644 index 0000000..04ed534 --- /dev/null +++ b/fortran/test/tH5D.f90 @@ -0,0 +1,452 @@ +! +! +! Testing Dataset Interface functionality. +! +! MODULE H5DTEST + +! USE HDF5 ! This module contains all necessary modules + +! CONTAINS + +! +!The following subroutine tests the following functionalities: +!h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, h5dget_type_f, +!h5dread_f, and h5dwrite_f +! + SUBROUTINE datasettest(total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=8), PARAMETER :: filename = "dsetf.h5" ! File name + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dspace_id ! Dataspace identifier + INTEGER(HID_T) :: dtype_id ! Datatype identifier + + + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions + INTEGER :: rank = 2 ! Dataset rank + + INTEGER, DIMENSION(4,6) :: dset_data, data_out ! Data buffers + INTEGER :: error ! Error flag + + INTEGER :: i, j !general purpose integers + + ! + ! Initialize the dset_data array. + ! + do i = 1, 4 + do j = 1, 6 + dset_data(i,j) = (i-1)*6 + j; + end do + end do + + ! + ! Initialize FORTRAN predefined datatypes. + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f", error, total_error) + + + ! + ! Create the dataspace. + ! + CALL h5screate_simple_f(rank, dims, dspace_id, error) + CALL check("h5screate_simple_f", error, total_error) + + + ! + ! Create the dataset with default properties. + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dspace_id, & + dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Write the dataset. + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, error) + CALL check("h5dwrite_f", error, total_error) + + + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + ! Open the existing file. + ! + CALL h5fopen_f (filename, H5F_ACC_RDWR_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + + ! + ! Open the existing dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + ! Get the dataset type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f", error, total_error) + + ! + ! Get the data space. + ! + CALL h5dget_space_f(dset_id, dspace_id, error) + CALL check("h5dget_space_f", error, total_error) + + ! + ! Read the dataset. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, error) + CALL check("h5dread_f", error, total_error) + + ! + !Compare the data. + ! + do i = 1, 4 + do j = 1, 6 + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + write(*, *) "dataset test error occured" + write(*,*) "data read is not the same as the data writen" + END IF + end do + end do + + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + + ! + ! Terminate access to the data type. + ! + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f", error, total_error) + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !Close FORTRAN predifined datatypes + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + + RETURN + END SUBROUTINE datasettest + +! +!the following subroutine tests h5dextend_f functionality +! + + SUBROUTINE extenddsettest(total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the dataset is stored in file "extf.h5" + ! + CHARACTER(LEN=7), PARAMETER :: filename = "extf.h5" + + ! + !dataset name is "ExtendibleArray" + ! + CHARACTER(LEN=15), PARAMETER :: dsetname = "ExtendibleArray" + + ! + !dataset rank is 2 + ! + INTEGER :: RANK = 2 + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memory Dataspace identifier + INTEGER(HID_T) :: crp_list ! dataset creatation property identifier + + ! + !dataset dimensions at creation time + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/3,3/) + + ! + !data dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/10,3/) + + ! + !Maximum dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: maxdims + + ! + !data arrays for reading and writing + ! + INTEGER, DIMENSION(10,3) :: data_in, data_out + + ! + !Size of data in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: size + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !Variables used in reading data back + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dimsr, maxdimsr + INTEGER :: rankr + + ! + !data initialization + ! + do i = 1, 10 + do j = 1, 3 + data_in(i,j) = 2 + end do + end do + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + ! + !Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + + ! + !Create the data space with unlimited dimensions. + ! + maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/) + + CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Modify dataset creation properties, i.e. enable chunking + ! + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error) + CALL check("h5pcreat_f",error,total_error) + + CALL h5pset_chunk_f(crp_list, RANK, dims1, error) + CALL check("h5pset_chunk_f",error,total_error) + + ! + !Create a dataset with 3X3 dimensions using cparms creation propertie . + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & + dset_id, error, crp_list ) + CALL check("h5dcreate_f",error,total_error) + + ! + !Extend the dataset. This call assures that dataset is 3 x 3. + ! + size(1) = 3 + size(2) = 3 + CALL h5dextend_f(dset_id, size, error) + CALL check("h5dextend_f",error,total_error) + + + ! + !Extend the dataset. Dataset becomes 10 x 3. + ! + size(1) = 10; + size(2) = 3; + CALL h5dextend_f(dset_id, size, error) + CALL check("h5dextend_f",error,total_error) + + ! + !Write the data of size 10X3 to the extended dataset. + ! + CALL H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Close the property list. + ! + CALL h5pclose_f(crp_list, error) + CALL check("h5pclose_f",error,total_error) + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !read the data back + ! + !Open the file. + ! + CALL h5fopen_f (filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("hfopen_f",error,total_error) + + ! + !Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's dataspace handle. + ! + CALL h5dget_space_f(dset_id, dataspace, error) + CALL check("h5dget_space_f",error,total_error) + + ! + !Get dataspace's rank. + ! + CALL h5sget_simple_extent_ndims_f(dataspace, rankr, error) + CALL check("h5sget_simple_extent_ndims_f",error,total_error) + IF (rankr .NE. RANK) then + write(*,*) "dataset rank error occured" + stop + END IF + + ! + !Get dataspace's dimensinons. + ! + CALL h5sget_simple_extent_dims_f(dataspace, dimsr, maxdimsr, error) + CALL check("h5sget_simple_extent_dims_f",error,total_error) + IF ((dimsr(1) .NE. dims1(1)) .OR. (dimsr(2) .NE. dims1(2))) THEN + write(*,*) "dataset dimensions error occured" + stop + END IF + + ! + !Get creation property list. + ! + CALL h5dget_create_plist_f(dset_id, crp_list, error) + CALL check("h5dget_create_plist_f",error,total_error) + + + ! + !create memory dataspace. + ! + CALL h5screate_simple_f(rankr, dimsr, memspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Read data + ! + CALL H5Dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, error, & + memspace, dataspace) + CALL check("h5dread_f",error,total_error) + + + ! + !Compare the data. + ! + do i = 1, dims1(1) + do j = 1, dims1(2) + IF (data_out(i,j) .NE. data_in(i, j)) THEN + write(*, *) "extend dataset test error occured" + write(*, *) "read value is not the same as the written values" + END IF + end do + end do + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Close the memspace for the dataset. + ! + CALL h5sclose_f(memspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Close the property list. + ! + CALL h5pclose_f(crp_list, error) + CALL check("h5pclose_f",error,total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + + RETURN + END SUBROUTINE extenddsettest + + + +! END MODULE H5DTEST diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 new file mode 100644 index 0000000..9c8a9f9 --- /dev/null +++ b/fortran/test/tH5F.f90 @@ -0,0 +1,516 @@ +! +! +! Testing File Interface functionality. +! +! MODULE H5FTEST + +! USE HDF5 ! This module contains all necessary modules + +! CONTAINS + +!In the mountingtest subroutine we create one file with a group in it, +!and another file with a dataset. Mounting is used to +!access the dataset from the second file as a member of a group +!in the first file. +! + SUBROUTINE mountingtest(total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the respective filename is "mount1.h5" and "mount2.h5" + ! + CHARACTER(LEN=9), PARAMETER :: filename1 = "mount1.h5" + CHARACTER(LEN=9), PARAMETER :: filename2 = "mount2.h5" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 + + ! + ! File identifiers + ! + INTEGER(HID_T) :: file1_id, file2_id + + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid + + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !return value for testing whether a file is in hdf5 format + ! + LOGICAL :: status + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + ! + !Initialize data_in buffer + ! + do i = 1, NX + do j = 1, NY + data_in(i,j) = (i-1) + (j-1) + end do + end do + + ! + !Create first file "mount1.h5" using default properties. + ! + CALL h5fcreate_f(filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) + + + ! + !Create group "/G" inside file "mount1.h5". + ! + CALL h5gcreate_f(file1_id, "/G", gid, error) + CALL check("h5gcreate_f",error,total_error) + + ! + !close file and group identifiers. + ! + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Create second file "mount2.h5" using default properties. + ! + CALL h5fcreate_f(filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/D" inside file "mount2.h5". + ! + CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close file, dataset and dataspace identifiers. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !test whether files are in hdf5 format + ! + CALL h5fis_hdf5_f(filename1, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", filename1, " is not in hdf5 format" + stop + END IF + + CALL h5fis_hdf5_f(filename2, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", filename2, " is not in hdf5 format" + stop + END IF + + ! + !reopen both files. + ! + CALL h5fopen_f (filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("hfopen_f",error,total_error) + CALL h5fopen_f (filename2, H5F_ACC_RDWR_F, file2_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !mount the second file under the first file's "/G" group. + ! + CALL h5fmount_f (file1_id, "/G", file2_id, error) + CALL check("h5fmount_f",error,total_error) + + + ! + !Access dataset D in the first file under /G/D name. + ! + CALL h5dopen_f(file1_id, "/G/D", dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's data type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, dtype_id, data_out, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. data_in(i, j)) THEN + write(*, *) "mounting test error occured" + END IF + end do + end do + + + ! + !Close dset_id and dtype_id. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + !unmount the second file. + ! + CALL h5funmount_f(file1_id, "/G", error); + CALL check("h5funmount_f",error,total_error) + + ! + !Close both files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + RETURN + END SUBROUTINE mountingtest + +! +!The following subroutine tests h5freopen_f. +!It creates the file which has name "reopen.h5" and +!the "/dset" dataset inside the file. +!writes the data to the file, close the dataset. +!Reopen the file based upon the file_id, open the +!dataset use the reopen_id then reads the +!dataset back to memory to test whether the data +!read is identical to the data written +! + + SUBROUTINE reopentest(total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the dataset is stored in file "dsetf.h5" + ! + CHARACTER(LEN=9), PARAMETER :: filename = "reopen.h5" + + INTEGER(HID_T) :: file_id, reopen_id ! File identifiers + INTEGER(HID_T) :: dset_id ! Dataset identifier + + ! + !dataset name is "dset" + ! + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 6 + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !array to store data + ! + INTEGER, DIMENSION(4,6) :: dset_data, data_out + + ! + !initialize the dset_data array which will be written to the "/dset" + ! + do i = 1, NX + do j = 1, NY + dset_data(i,j) = (i-1)*6 + j; + end do + end do + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + + ! + !Create file "reopen.h5" using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/dset" inside the file . + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + !Write the dataset. + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !close the dataspace. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Reopen file dsetf.h5. + ! + CALL h5freopen_f(file_id, reopen_id, error) + CALL check("h5freopen_f",error,total_error) + + ! + !Open the dataset based on the reopen_id. + ! + CALL h5dopen_f(reopen_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + write(*, *) "reopen test error occured" + END IF + end do + end do + + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(reopen_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Close FORTRAN predifined datatypes + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + + + RETURN + + END SUBROUTINE reopentest + +! +!The following example demonstrates how to get creation property list, +!and access property list. +!We first create a file using the default creation and access property +!list. Then, the file was closed and reopened. We then get the +!creation and access property lists of the first file. The second file is +!created using the got property lists + + SUBROUTINE plisttest(total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !file names are "plist1.h5" and "plist2.h5" + ! + CHARACTER(LEN=9), PARAMETER :: filename1 = "plist1.h5" + CHARACTER(LEN=9), PARAMETER :: filename2 = "plist2.h5" + + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: prop_id ! File creation property list identifier + INTEGER(HID_T) :: access_id ! File Access property list identifier + + !flag to check operation success + INTEGER :: error + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + ! + !Create a file1 using default properties. + ! + CALL h5fcreate_f(filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Terminate access to the file. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Open an existing file. + ! + CALL h5fopen_f (filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !get the creation property list. + ! + CALL h5fget_create_plist_f(file1_id, prop_id, error) + CALL check("h5fget_create_plist_f",error,total_error) + + ! + !get the access property list. + ! + CALL h5fget_access_plist_f(file1_id, access_id, error) + CALL check("h5fget_access_plist_f",error,total_error) + + ! + !based on the creation property list id and access property list id + !create a new file + ! + CALL h5fcreate_f(filename2, H5F_ACC_TRUNC_F, file2_id, error, & + prop_id, access_id) + CALL check("h5create_f",error,total_error) + + ! + !Close all the property lists. + ! + CALL h5pclose_f(prop_id, error) + CALL check("h5pclose_f",error,total_error) + CALL h5pclose_f(access_id, error) + CALL check("h5pclose_f",error,total_error) + + ! + !Terminate access to the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Close FORTRAN predifined datatypes + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + RETURN + + END SUBROUTINE plisttest + + + +! END MODULE H5FTEST + + diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 new file mode 100644 index 0000000..ed7ca60 --- /dev/null +++ b/fortran/test/tH5P.f90 @@ -0,0 +1,101 @@ + + SUBROUTINE external_test(total_error) +!THis subroutine tests following functionalities: +!h5pset_external_f, h5pget_external_count_f, +!h5pget_external_f + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=11), PARAMETER :: filename = "external.h5" + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: plist_id + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: dataset_id + INTEGER(HSIZE_T), DIMENSION(1) :: cur_size !data space current size + INTEGER(HSIZE_T), DIMENSION(1) :: max_size !data space maximum size + CHARACTER*256 :: name !external file name + INTEGER :: file_offset !external file offset + INTEGER(HSIZE_T) :: file_size !sizeof external file segment + INTEGER :: error !error code + INTEGER(SIZE_T) :: int_size !size of integer + INTEGER(HSIZE_T) :: file_bytes !Number of bytes reserved + !in the file for the data + INTEGER :: RANK = 1 !dataset rank + INTEGER :: count !number of external files for the + !specified dataset + INTEGER(SIZE_T) :: namesize + + ! + ! Initialize FORTRAN predefined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + ! + !Create file "external.h5" using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, plist_id, error) + CALL check("h5pcreate_f",error,total_error) + cur_size(1) =100 + max_size(1) = 100; + call h5tget_size_f(H5T_NATIVE_INTEGER, int_size, error) + CALL check("h5tget_size_f",error,total_error) + file_size = int_size * max_size(1); + CALL h5pset_external_f(plist_id, "ext1.data", 0, file_size, error) + CALL check("h5pset_external_f",error,total_error) + CALL h5screate_simple_f(RANK, cur_size, space_id, error, max_size) + CALL check("h5screate_simple_f", error, total_error) + CALL h5dcreate_f(file_id, "dset1", H5T_NATIVE_INTEGER, space_id, & + dataset_id, error, plist_id) + CALL check("h5dcreate_f", error, total_error) + + CALL h5dclose_f(dataset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + ! Read dataset creation information + CALL h5dopen_f(file_id, "dset1", dataset_id, error) + CALL check("h5dopen_f",error,total_error) + + CALL h5dget_create_plist_f(dataset_id, plist_id, error) + CALL check("h5dget_create_plist_f",error,total_error) + CALL h5pget_external_count_f(plist_id, count, error) + CALL check("h5pget_external_count_f",error,total_error) + if(count .ne. 1 ) then + write (*,*) "got external_count is not correct" + total_error = total_error + 1 + end if + namesize = 10 + CALL h5pget_external_f(plist_id, 0, namesize, name, file_offset, & + file_bytes, error) + CALL check("h5pget_external_f",error,total_error) + if(file_offset .ne. 0 ) then + write (*,*) "got external file offset is not correct" + total_error = total_error + 1 + end if + if(file_bytes .ne. file_size ) then + write (*,*) "got external file size is not correct" + total_error = total_error + 1 + end if + + CALL h5dclose_f(dataset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5pclose_f(plist_id, error) + CALL check("h5pclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + + RETURN + END SUBROUTINE external_test + diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90 new file mode 100644 index 0000000..56b7a21 --- /dev/null +++ b/fortran/test/tH5R.f90 @@ -0,0 +1,367 @@ +! +! +! Testing Reference Interface functionality. +! +! MODULE H5RTEST + +! USE HDF5 ! This module contains all necessary modules + +! CONTAINS +! +!The following subroutine tests h5rcreate_f, h5rdereference_f +!and H5Rget_object_type functions +! + SUBROUTINE refobjtest(total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=12), PARAMETER :: filename = "reference.h5" + CHARACTER(LEN=8), PARAMETER :: dsetnamei = "INTEGERS" + CHARACTER(LEN=17), PARAMETER :: dsetnamer = "OBJECT_REFERENCES" + CHARACTER(LEN=6), PARAMETER :: groupname1 = "GROUP1" + CHARACTER(LEN=6), PARAMETER :: groupname2 = "GROUP2" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: grp1_id ! Group identifier + INTEGER(HID_T) :: grp2_id ! Group identifier + INTEGER(HID_T) :: dset1_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER(HID_T) :: type_id ! Type identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier + INTEGER :: error, obj_type + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/5/) + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr= (/4/) + INTEGER(HSIZE_T), DIMENSION(1) :: my_maxdims = (/5/) + INTEGER :: rank = 1 + INTEGER :: rankr = 1 + TYPE(hobj_ref_t_f), DIMENSION(4) :: ref + TYPE(hobj_ref_t_f), DIMENSION(4) :: ref_out + INTEGER, DIMENSION(5) :: data = (/1, 2, 3, 4, 5/) + + ! + ! Initialize FORTRAN predefined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + ! + !Create a new file with Default file access and + !file creation properties . + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + + ! + ! Create a group inside the file + ! + CALL h5gcreate_f(file_id, groupname1, grp1_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! + ! Create a group inside the group GROUP1 + ! + CALL h5gcreate_f(grp1_id, groupname2, grp2_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! + ! Create dataspaces for datasets + ! + CALL h5screate_simple_f(rank, dims, space_id, error, maxdims=my_maxdims) + CALL check("h5screate_simple_f",error,total_error) + CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + ! Create integer dataset + ! + CALL h5dcreate_f(file_id, dsetnamei, H5T_NATIVE_INTEGER, space_id, & + dset1_id, error) + CALL check("h5dcreate_f",error,total_error) + ! + ! Create dataset to store references to the objects + ! + CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_OBJ, spacer_id, & + dsetr_id, error) + CALL check("h5dcreate_f",error,total_error) + ! + ! Create a datatype and store in the file + ! + CALL h5tcopy_f(H5T_NATIVE_REAL, type_id, error) + CALL check("h5tcopy_f",error,total_error) + CALL h5tcommit_f(file_id, "MyType", type_id, error) + CALL check("h5tcommit_f",error,total_error) + + ! + ! Close dataspaces, groups and integer dataset + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(spacer_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5gclose_f(grp1_id, error) + CALL check("h5gclose_f",error,total_error) + CALL h5gclose_f(grp2_id, error) + CALL check("h5gclose_f",error,total_error) + + + ! + ! Craete references to two groups, integer dataset and shared datatype + ! and write it to the dataset in the file + ! + CALL h5rcreate_f(file_id, groupname1, ref(1), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, "/GROUP1/GROUP2", ref(2), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, dsetnamei, ref(3), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, "MyType", ref(4), error) + CALL check("h5rcreate_f",error,total_error) + + CALL h5dwrite_f(dsetr_id, H5T_STD_REF_OBJ, ref, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !Close the dataset + ! + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + ! Reopen the dataset with object references + ! + CALL h5dopen_f(file_id, dsetnamer,dsetr_id,error) + CALL check("h5dopen_f",error,total_error) + CALL h5dread_f(dsetr_id, H5T_STD_REF_OBJ, ref_out, error) + CALL check("h5dread_f",error,total_error) + + ! + !get the third reference's type and Dereference it + ! + CALL h5rget_object_type_obj_f(dsetr_id, ref(3), obj_type, error) + CALL check("h5rget_object_type_obj_f",error,total_error) + if (obj_type == 2) then + CALL h5rdereference_f(dsetr_id, ref(3), dset1_id, error) + CALL check("h5rdereference_f",error,total_error) + + CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, data, error) + CALL check("h5dwrite_f",error,total_error) + end if + + ! + !get the fourth reference's type and Dereference it + ! + CALL h5rget_object_type_obj_f(dsetr_id, ref(4), obj_type, error) + CALL check("h5rget_object_type_obj_f",error,total_error) + if (obj_type == 3) then + CALL h5rdereference_f(dsetr_id, ref(4), type_id, error) + CALL check("h5rdereference_f",error,total_error) + end if + + ! + ! Close all objects. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f",error,total_error) + + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + RETURN + + END SUBROUTINE refobjtest +! +!The following subroutine tests h5rget_region_f, h5rcreate_f +!and h5rdereference_f functionalities +! + SUBROUTINE refregtest(total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=9), PARAMETER :: filename = "Refreg.h5" + CHARACTER(LEN=6), PARAMETER :: dsetnamev = "MATRIX" + CHARACTER(LEN=17), PARAMETER :: dsetnamer = "REGION_REFERENCES" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier + INTEGER(HID_T) :: dsetv_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER :: error + TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref ! Buffers to store references + TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref_out ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! + INTEGER(HSSIZE_T), DIMENSION(2) :: start + INTEGER(HSIZE_T), DIMENSION(2) :: count + INTEGER :: rankr = 1 + INTEGER :: rank = 2 + INTEGER , DIMENSION(2,9) :: data + INTEGER , DIMENSION(2,9) :: data_out = 0 + INTEGER(HSSIZE_T) , DIMENSION(2,3) :: coord + INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points + INTEGER :: i, j + coord = reshape((/1,1,2,7,1,9/), (/2,3/)) ! Coordinates of selected points + data = reshape ((/1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6/), (/2,9/)) + + ! + ! Initialize FORTRAN predefined datatypes. + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + ! + ! Create a new file. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + ! Default file access and file creation + ! properties are used. + CALL check("h5fcreate_f", error, total_error) + ! + ! Create dataspaces: + ! + ! for dataset with references to dataset regions + ! + CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! for integer dataset + ! + CALL h5screate_simple_f(rank, dims, space_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! Create and write datasets: + ! + ! Integer dataset + ! + CALL h5dcreate_f(file_id, dsetnamev, H5T_NATIVE_INTEGER, space_id, & + dsetv_id, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dwrite_f(dsetv_id, H5T_NATIVE_INTEGER, data, error) + CALL check("h5dwrite_f", error, total_error) + + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + ! + ! Dataset with references + ! + CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_DSETREG, spacer_id, & + dsetr_id, error) + CALL check("h5dcreate_f", error, total_error) + ! + ! Create a reference to the hyperslab selection. + ! + start(1) = 0 + start(2) = 3 + count(1) = 2 + count(2) = 3 + CALL h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, & + start, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) + CALL check("h5rcreate_f", error, total_error) + ! + ! Create a reference to elements selection. + ! + CALL h5sselect_none_f(space_id, error) + CALL check("h5sselect_none_f", error, total_error) + CALL h5sselect_elements_f(space_id, H5S_SELECT_SET_F, rank, num_points,& + coord, error) + CALL check("h5sselect_elements_f", error, total_error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(2), error) + CALL check("h5rcreate_f", error, total_error) + ! + ! Write dataset with the references. + ! + CALL h5dwrite_f(dsetr_id, H5T_STD_REF_DSETREG, ref, error) + CALL check("h5dwrite_f", error, total_error) + ! + ! Close all objects. + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5sclose_f(spacer_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + ! + ! Reopen the file to test selections. + ! + CALL h5fopen_f (filename, H5F_ACC_RDWR_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + CALL h5dopen_f(file_id, dsetnamer, dsetr_id, error) + CALL check("h5dopen_f", error, total_error) + ! + ! Read references to the dataset regions. + ! + CALL h5dread_f(dsetr_id, H5T_STD_REF_DSETREG, ref_out, error) + CALL check("h5dread_f", error, total_error) + ! + ! Dereference the first reference. + ! + CALL H5rdereference_f(dsetr_id, ref_out(1), dsetv_id, error) + CALL check("h5rdereference_f", error, total_error) + CALL H5rget_region_f(dsetr_id, ref_out(1), space_id, error) + CALL check("h5rget_region_f", error, total_error) + ! + ! Read selected data from the dataset. + ! + CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, error, & + mem_space_id = space_id, file_space_id = space_id) + CALL check("h5dread_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + data_out = 0 + ! + ! Dereference the second reference. + ! + CALL H5rdereference_f(dsetr_id, ref_out(2), dsetv_id, error) + CALL check("h5rdereference_f", error, total_error) + CALL H5rget_region_f(dsetr_id, ref_out(2), space_id, error) + CALL check("h5rget_region_f", error, total_error) + ! + ! Read selected data from the dataset. + ! + CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, error, & + mem_space_id = space_id, file_space_id = space_id) + CALL check("h5dread_f", error, total_error) + ! + ! Close all objects + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + RETURN + + END SUBROUTINE refregtest + + +! END MODULE H5RTEST diff --git a/fortran/test/tH5S.f90 b/fortran/test/tH5S.f90 new file mode 100644 index 0000000..7d64ada --- /dev/null +++ b/fortran/test/tH5S.f90 @@ -0,0 +1,247 @@ +! +! +! Testing Dataspace Interface functionality. +! +! MODULE H5STEST + +! USE HDF5 ! This module contains all necessary modules + +! CONTAINS + +! +!The following subroutine tests the following functionalities: +!h5screate_f, h5scopy_f, h5screate_simple_f, h5sis_simple_f, +!h5sget_simple_extent_dims_f,h5sget_simple_extent_ndims_f +!h5sget_simple_extent_npoints_f, h5sget_simple_extent_type_f, +!h5sextent_copy_f, h5sset_extent_simple_f, h5sset_extent_none_f +! + SUBROUTINE dataspace_basic_test(total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=13), PARAMETER :: filename1 = "basicspace.h5" ! File1 name + CHARACTER(LEN=12), PARAMETER :: filename2 = "copyspace.h5" ! File2 name + CHARACTER(LEN=9), PARAMETER :: dsetname = "basicdset" ! Dataset name + + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: dset1_id, dset2_id ! Dataset identifiers + INTEGER(HID_T) :: space1_id, space2_id ! Dataspace identifiers + + INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/4,6/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(2) :: maxdims1 = (/4,6/) ! maximum dimensions + INTEGER(HSIZE_T), DIMENSION(2) :: dims2 = (/6,6/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(2) :: maxdims2 = (/6,6/) ! maximum dimensions + INTEGER(HSIZE_T), DIMENSION(2) :: dimsout, maxdimsout ! dimensions + INTEGER(HSIZE_T) :: npoints !number of elements in the dataspace + + INTEGER :: rank1 = 2 ! Dataspace1 rank + INTEGER :: rank2 = 2 ! Dataspace2 rank + INTEGER :: classtype ! Dataspace class type + + INTEGER, DIMENSION(4,6) :: data1_in, data1_out ! Data input buffers + INTEGER, DIMENSION(6,6) :: data2_in, data2_out ! Data output buffers + INTEGER :: error ! Error flag + + LOGICAL :: flag !flag to test datyspace is simple or not + INTEGER :: i, j !general purpose integers + + ! + ! Initialize the dset_data array. + ! + do i = 1, 4 + do j = 1, 6 + data1_in(i,j) = (i-1)*6 + j; + end do + end do + + do i = 1, 6 + do j = 1, 6 + data2_in(i,j) = i*6 + j; + end do + end do + + ! + ! Initialize FORTRAN predefined datatypes. + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + + ! + ! Create new files using default properties. + ! + CALL h5fcreate_f(filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f", error, total_error) + + CALL h5fcreate_f(filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f", error, total_error) + + ! + ! Create dataspace for file1. + ! + CALL h5screate_simple_f(rank1, dims1, space1_id, error, maxdims1) + CALL check("h5screate_simple_f", error, total_error) + ! + ! Copy space1_id to space2_id. + ! + CALL h5scopy_f(space1_id, space2_id, error) + CALL check("h5scopy_f", error, total_error) + + ! + !Check whether copied space is simple. + ! + CALL h5sis_simple_f(space2_id, flag, error) + CALL check("h5sissimple_f", error, total_error) + IF (.NOT. flag) write(*,*) "dataspace is not simple type" + + ! + !set the copied space to none. + ! + CALL h5sset_extent_none_f(space2_id, error) + CALL check("h5sset_extent_none_f", error, total_error) + + ! + !copy the extent of space1_id to space2_id. + ! + CALL h5sextent_copy_f(space2_id, space1_id, error) + CALL check("h5sextent_copy_f", error, total_error) + + ! + !get the copied space's dimensions. + ! + CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error) + CALL check("h5sget_simple_extent_dims_f", error, total_error) + IF ((dimsout(1) .NE. dims1(1)) .OR. (dimsout(2) .NE. dims1(2)) ) THEN + write(*,*)"error occured, copied dims not same" + END IF + + ! + !get the copied space's rank. + ! + CALL h5sget_simple_extent_ndims_f(space2_id, rank2, error) + CALL check("h5sget_simple_extent_ndims_f", error, total_error) + IF (rank2 .NE. rank1) write(*,*)"error occured, copied ranks not same" + + ! + !get the copied space's number of elements. + ! + CALL h5sget_simple_extent_npoints_f(space2_id, npoints, error) + CALL check("h5sget_simple_extent_npoints_f", error, total_error) + IF (npoints .NE. 24) write(*,*)"error occured, number of elements not correct" + + + ! + !get the copied space's class type. + ! + CALL h5sget_simple_extent_type_f(space2_id, classtype, error) + CALL check("h5sget_simple_extent_type_f", error, total_error) + IF (classtype .NE. 1) write(*,*)"class type not H5S_SIMPLE_f" + + ! + !set the copied space to dim2 size. + ! + CALL h5sset_extent_simple_f(space2_id, rank2, dims2, maxdims2, error) + CALL check("h5sset_extent_simple_f", error, total_error) + + ! + !get the copied space's dimensions. + ! + CALL h5sget_simple_extent_dims_f(space2_id, dimsout, maxdimsout, error) + CALL check("h5sget_simple_extent_dims_f", error, total_error) + IF ((dimsout(1) .NE. dims2(1)) .OR. (dimsout(2) .NE. dims2(2)) ) THEN + write(*,*)"error occured, copied dims not same" + END IF + + ! + ! Create the datasets with default properties in two files. + ! + CALL h5dcreate_f(file1_id, dsetname, H5T_NATIVE_INTEGER, space1_id, & + dset1_id, error) + CALL check("h5dcreate_f", error, total_error) + + CALL h5dcreate_f(file2_id, dsetname, H5T_NATIVE_INTEGER, space2_id, & + dset2_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Write the datasets. + ! + CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, data1_in, error) + CALL check("h5dwrite_f", error, total_error) + + CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, data2_in, error) + CALL check("h5dwrite_f", error, total_error) + + ! + ! Read the first dataset. + ! + CALL h5dread_f(dset1_id, H5T_NATIVE_INTEGER, data1_out, error) + CALL check("h5dread_f", error, total_error) + + ! + !Compare the data. + ! + do i = 1, 4 + do j = 1, 6 + IF (data1_out(i,j) .NE. data1_in(i, j)) THEN + write(*, *) "dataset test error occured" + write(*,*) "data read is not the same as the data writen" + END IF + end do + end do + + + ! + ! Read the second dataset. + ! + CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, data2_out, error) + CALL check("h5dread_f", error, total_error) + + ! + !Compare the data. + ! + do i = 1, 6 + do j = 1, 6 + IF (data2_out(i,j) .NE. data2_in(i, j)) THEN + write(*, *) "dataset test error occured" + write(*,*) "data read is not the same as the data writen" + END IF + end do + end do + + ! + !Close the datasets. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5dclose_f(dset2_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data spaces. + ! + CALL h5sclose_f(space1_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5sclose_f(space2_id, error) + CALL check("h5sclose_f", error, total_error) + ! + ! Close the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f", error, total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !Close FORTRAN predifined datatypes + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f",error,total_error) + + RETURN + END SUBROUTINE dataspace_basic_test + + +! END MODULE H5STEST diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 new file mode 100644 index 0000000..c7cd398 --- /dev/null +++ b/fortran/test/tH5Sselect.f90 @@ -0,0 +1,991 @@ +! +! Testing Selection-related Dataspace Interface functionality. +! + +! +!The following subroutines tests the following functionalities: +!h5sget_select_npoints_f, h5sselect_elements_f, h5sselect_all_f, +!h5sselect_none_f, h5sselect_valid_f, h5sselect_hyperslab_f, +!h5sget_select_bounds_f, h5sget_select_elem_pointlist_f, +!h5sget_select_elem_npoints_f, h5sget_select_hyper_blocklist_f, +!h5sget_select_hyper_nblocks_f, h5sget_select_npoints_f +! + + SUBROUTINE test_select_hyperslab(total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the dataset is stored in file "sdsf.h5" + ! + CHARACTER(LEN=7), PARAMETER :: filename = "sdsf.h5" + + ! + !dataset name is "IntArray" + ! + CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier + + ! + !Memory space dimensions + ! + INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) + + ! + !to get Dataset dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims_out + + ! + !Dataset dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) + + ! + !Size of the hyperslab in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: count = (/3,4/) + + ! + !hyperslab offset in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/1,2/) + + ! + !Size of the hyperslab in memory + ! + INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) + + ! + !hyperslab offset in memory + ! + INTEGER(HSIZE_T), DIMENSION(3) :: offset_out = (/3,0,0/) + + ! + !data to write + ! + INTEGER, DIMENSION(5,6) :: data + + ! + !output buffer + ! + INTEGER, DIMENSION(7,7,3) :: data_out + + + ! + !dataset space rank + ! + INTEGER :: dsetrank = 2 + + ! + !memspace rank + ! + INTEGER :: memrank = 3 + + ! + !integer to get the dataspace rank from dataset + ! + INTEGER :: rank + + + ! + !general purpose integer + ! + INTEGER :: i, j, k + + ! + !flag to check operation success + ! + INTEGER :: error, error_n + + + ! + !This writes data to the HDF5 file. + ! + + ! + !data initialization + ! + do i = 1, 5 + do j = 1, 6 + data(i,j) = (i-1) + (j-1); + end do + end do + ! + ! 0, 1, 2, 3, 4, 5 + ! 1, 2, 3, 4, 5, 6 + ! 2, 3, 4, 5, 6, 7 + ! 3, 4, 5, 6, 7, 8 + ! 4, 5, 6, 7, 8, 9 + ! + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + + ! + !Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f", error, total_error) + + ! + !Create the data space for the dataset. + ! + CALL h5screate_simple_f(dsetrank, dimsf, dataspace, error) + CALL check("h5screate_simple_f", error, total_error) + + ! + ! Create the dataset with default properties + ! + CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & + dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Write the dataset + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, error) + CALL check("h5dwrite_f", error, total_error) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !This reads the hyperslab from the sds.h5 file just + !created, into a 2-dimensional plane of the 3-dimensional array. + ! + + ! + !initialize data_out array + ! + ! do i = 1, 7 + ! do j = 1, 7 + ! do k = 1,3 + ! data_out(i,j,k) = 0; + ! end do + ! end do + ! end do + + ! + !Open the file. + ! + CALL h5fopen_f (filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + + ! + !Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + !Get dataset's dataspace handle. + ! + CALL h5dget_space_f(dset_id, dataspace, error) + CALL check("h5dget_space_f", error, total_error) + + ! + !Select hyperslab in the dataset. + ! + CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & + offset, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + ! + !create memory dataspace. + ! + CALL h5screate_simple_f(memrank, dimsm, memspace, error) + CALL check("h5screate_simple_f", error, total_error) + + ! + !Select hyperslab in memory. + ! + CALL h5sselect_hyperslab_f(memspace, H5S_SELECT_SET_F, & + offset_out, count_out, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + ! + !Read data from hyperslab in the file into the hyperslab in + !memory and display. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, error, & + memspace, dataspace) + CALL check("h5dread_f", error, total_error) + + ! + !Display data_out array + ! + !do i = 1, 7 + ! print *, (data_out(i,j,1), j = 1,7) + !end do + + ! 0 0 0 0 0 0 0 + ! 0 0 0 0 0 0 0 + ! 0 0 0 0 0 0 0 + ! 3 4 5 6 0 0 0 + ! 4 5 6 7 0 0 0 + ! 5 6 7 8 0 0 0 + ! 0 0 0 0 0 0 0 + ! + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the memoryspace. + ! + CALL h5sclose_f(memspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + RETURN + + END SUBROUTINE test_select_hyperslab + + ! + !Subroutine to test element selection + ! + + SUBROUTINE test_select_element(total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the dataset1 is stored in file "copy1.h5" + ! + CHARACTER(LEN=8), PARAMETER :: filename1 = "copy1.h5" + + ! + !the dataset2 is stored in file "copy2.h5" + ! + CHARACTER(LEN=8), PARAMETER :: filename2 = "copy2.h5" + ! + !dataset1 name is "Copy1" + ! + CHARACTER(LEN=8), PARAMETER :: dsetname1 = "Copy1" + + ! + !dataset2 name is "Copy2" + ! + CHARACTER(LEN=8), PARAMETER :: dsetname2 = "Copy2" + + ! + !dataset rank + ! + INTEGER, PARAMETER :: RANK = 2 + + ! + !number of points selected + ! + INTEGER(SIZE_T), PARAMETER :: NUMP = 2 + + INTEGER(HID_T) :: file1_id ! File1 identifier + INTEGER(HID_T) :: file2_id ! File2 identifier + INTEGER(HID_T) :: dset1_id ! Dataset1 identifier + INTEGER(HID_T) :: dset2_id ! Dataset2 identifier + INTEGER(HID_T) :: dataspace1 ! Dataspace identifier + INTEGER(HID_T) :: dataspace2 ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier + + ! + !Memory space dimensions + ! + INTEGER(HSIZE_T), DIMENSION(1) :: dimsm = (/2/) + + ! + !Dataset dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/3,4/) + + ! + !Points positions in the file + ! + INTEGER(HSSIZE_T), DIMENSION(RANK,NUMP) :: coord + + ! + !data buffers + ! + INTEGER, DIMENSION(3,4) :: buf1, buf2, bufnew + + ! + !value to write + ! + INTEGER, DIMENSION(2) :: val = (/53, 59/) + + ! + !memory rank + ! + INTEGER :: memrank = 1 + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !flag to check operation success + ! + INTEGER :: error + LOGICAL :: status + + + ! + !Create two files containing identical datasets. Write 0's to one + !and 1's to the other. + ! + + ! + !data initialization + ! + do i = 1, 3 + do j = 1, 4 + buf1(i,j) = 0; + end do + end do + + do i = 1, 3 + do j = 1, 4 + buf2(i,j) = 1; + end do + end do + + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + + ! + !Create file1, file2 using default properties. + ! + CALL h5fcreate_f(filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f", error, total_error) + + CALL h5fcreate_f(filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f", error, total_error) + + ! + !Create the data space for the datasets. + ! + CALL h5screate_simple_f(RANK, dimsf, dataspace1, error) + CALL check("h5screate_simple_f", error, total_error) + + CALL h5screate_simple_f(RANK, dimsf, dataspace2, error) + CALL check("h5screate_simple_f", error, total_error) + + ! + ! Create the datasets with default properties + ! + CALL h5dcreate_f(file1_id, dsetname1, H5T_NATIVE_INTEGER, dataspace1, & + dset1_id, error) + CALL check("h5dcreate_f", error, total_error) + + CALL h5dcreate_f(file2_id, dsetname2, H5T_NATIVE_INTEGER, dataspace2, & + dset2_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Write the datasets + ! + CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, buf1, error) + CALL check("h5dwrite_f", error, total_error) + + CALL h5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, buf2, error) + CALL check("h5dwrite_f", error, total_error) + + ! + !Close the dataspace for the datasets. + ! + CALL h5sclose_f(dataspace1, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(dataspace2, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the datasets. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dclose_f(dset2_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f", error, total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !Open the two files. Select two points in one file, write values to + !those point locations, then do H5Scopy and write the values to the + !other file. Close files. + ! + + ! + !Open the files. + ! + CALL h5fopen_f (filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f", error, total_error) + + CALL h5fopen_f (filename2, H5F_ACC_RDWR_F, file2_id, error) + CALL check("h5fopen_f", error, total_error) + + ! + !Open the datasets. + ! + CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) + CALL check("h5dopen_f", error, total_error) + + CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + !Get dataset1's dataspace handle. + ! + CALL h5dget_space_f(dset1_id, dataspace1, error) + CALL check("h5dget_space_f", error, total_error) + + ! + !create memory dataspace. + ! + CALL h5screate_simple_f(memrank, dimsm, memspace, error) + CALL check("h5screate_simple_f", error, total_error) + + ! + !Set the selected point positions.Because Fortran array index starts + ! from 1, so add one to the actual select points in C + ! + coord(1,1) = 1 + coord(2,1) = 2 + coord(1,2) = 1 + coord(2,2) = 4 + + ! + !Select the elements in file space + ! + CALL h5sselect_elements_f(dataspace1, H5S_SELECT_SET_F, RANK, NUMP,& + coord, error) + CALL check("h5sselect_elements_f", error, total_error) + + ! + !Write value into the selected points in dataset1 + ! + CALL H5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, val, error, & + mem_space_id=memspace, file_space_id=dataspace1) + CALL check("h5dwrite_f", error, total_error) + + ! + !Copy the daspace1 into dataspace2 + ! + CALL h5scopy_f(dataspace1, dataspace2, error) + CALL check("h5scopy_f", error, total_error) + + ! + !Write value into the selected points in dataset2 + ! + CALL H5dwrite_f(dset2_id, H5T_NATIVE_INTEGER, val, error, & + mem_space_id=memspace, file_space_id=dataspace2) + CALL check("h5dwrite_f", error, total_error) + + ! + !Close the dataspace for the datasets. + ! + CALL h5sclose_f(dataspace1, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(dataspace2, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the memoryspace. + ! + CALL h5sclose_f(memspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the datasets. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dclose_f(dset2_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f", error, total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !Open both files and print the contents of the datasets. + ! + + ! + !Open the files. + ! + CALL h5fopen_f (filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f", error, total_error) + + CALL h5fopen_f (filename2, H5F_ACC_RDWR_F, file2_id, error) + CALL check("h5fopen_f", error, total_error) + + ! + !Open the datasets. + ! + CALL h5dopen_f(file1_id, dsetname1, dset1_id, error) + CALL check("h5dopen_f", error, total_error) + + CALL h5dopen_f(file2_id, dsetname2, dset2_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + !Read dataset1. + ! + CALL h5dread_f(dset1_id, H5T_NATIVE_INTEGER, bufnew, error) + CALL check("h5dread_f", error, total_error) + + ! + !Display the data read from dataset "Copy1" + ! + !write(*,*) "The data in dataset Copy1 is: " + !do i = 1, 3 + ! print *, (bufnew(i,j), j = 1,4) + !end do + + ! + !Read dataset2. + ! + CALL h5dread_f(dset2_id, H5T_NATIVE_INTEGER, bufnew, error) + CALL check("h5dread_f", error, total_error) + + ! + !Display the data read from dataset "Copy2" + ! + !write(*,*) "The data in dataset Copy2 is: " + !do i = 1, 3 + ! print *, (bufnew(i,j), j = 1,4) + !end do + + ! + !Close the datasets. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dclose_f(dset2_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f", error, total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + + END SUBROUTINE test_select_element + + + SUBROUTINE test_basic_select(total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + ! + !the dataset is stored in file "testselect.h5" + ! + CHARACTER(LEN=13), PARAMETER :: filename = "testselect.h5" + + ! + !dataspace rank + ! + INTEGER, PARAMETER :: RANK = 2 + + ! + !select NUMP_POINTS points from the file + ! + INTEGER(SIZE_T), PARAMETER :: NUMPS = 10 + + ! + !dataset name is "testselect" + ! + CHARACTER(LEN=10), PARAMETER :: dsetname = "testselect" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: memspace ! memspace identifier + + ! + !Dataset dimensions + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dimsf = (/5,6/) + + ! + !Size of the hyperslab in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: count = (/2,2/) + + ! + !hyperslab offset in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: offset = (/0,0/) + + ! + !start block for getting the selected hyperslab + ! + INTEGER(HSIZE_T), DIMENSION(2) :: startblock = (/0,0/) + + ! + !start point for getting the selected elements + ! + INTEGER(HSIZE_T), DIMENSION(2) :: startpoint = (/0,0/) +! INTEGER(HSIZE_T), DIMENSION(2) :: startpoint = (/1,1/) + + ! + !Stride of the hyperslab in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: stride = (/3,3/) + + ! + !BLock size of the hyperslab in the file + ! + INTEGER(HSIZE_T), DIMENSION(2) :: block = (/2,2/) + + ! + !array to give selected points' coordinations + ! + INTEGER(HSSIZE_T), DIMENSION(RANK, NUMPS) :: coord + + ! + !Size of the hyperslab in memory + ! + INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) + + ! + !Number of hyperslabs selected in the current dataspace + ! + INTEGER(HSSIZE_T) :: num_blocks + + ! + !allocatable array for putting a list of hyperslabs + !selected in the current file dataspace + ! + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: blocklist + + ! + !Number of points selected in the current dataspace + ! + INTEGER(HSSIZE_T) :: num_points + INTEGER(HSIZE_T) :: num1_points + + ! + !allocatable array for putting a list of points + !selected in the current file dataspace + ! + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: pointlist + + ! + !start and end bounds in the current dataspac selection + ! + INTEGER(HSIZE_T), DIMENSION(RANK) :: startout, endout + + ! + !data to write + ! + INTEGER, DIMENSION(5,6) :: data + + ! + !output buffer + ! + INTEGER, DIMENSION(7,7,3) :: data_out + + ! + !general purpose integer + ! + INTEGER :: i, j, k + + ! + !flag to check operation success + ! + INTEGER :: error, error_n + + ! + !initialize the coord array to give the selected points' position + ! + coord(1,1) = 1 + coord(2,1) = 1 + coord(1,2) = 1 + coord(2,2) = 3 + coord(1,3) = 1 + coord(2,3) = 5 + coord(1,4) = 3 + coord(2,4) = 1 + coord(1,5) = 3 + coord(2,5) = 3 + coord(1,6) = 3 + coord(2,6) = 5 + coord(1,7) = 4 + coord(2,7) = 3 + coord(1,8) = 4 + coord(2,8) = 1 + coord(1,9) = 5 + coord(2,9) = 3 + coord(1,10) = 5 + coord(2,10) = 5 + ! + !Initialize FORTRAN predifined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + + ! + !Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f", error, total_error) + + ! + !Create the data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dimsf, dataspace, error) + CALL check("h5screate_simple_f", error, total_error) + + ! + ! Create the dataset with default properties + ! + CALL h5dcreate_f(file_id, dsetname, H5T_STD_I32BE, dataspace, & + dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! + ! Write the dataset + ! + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, error) + CALL check("h5dwrite_f", error, total_error) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + !Open the file. + ! + CALL h5fopen_f (filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + + ! + !Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f", error, total_error) + + ! + !Get dataset's dataspace handle. + ! + CALL h5dget_space_f(dset_id, dataspace, error) + CALL check("h5dget_space_f", error, total_error) + + ! + !Select hyperslab in the dataset. + ! + CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, & + offset, count, error, stride, block) + CALL check("h5sselect_hyperslab_f", error, total_error) + + ! + !get the number of hyperslab blocks in the current dataspac selection + ! + CALL h5sget_select_hyper_nblocks_f(dataspace, num_blocks, error) + CALL check("h5sget_select_hyper_nblocks_f", error, total_error) + IF (num_blocks .NE. 4) write (*,*) "error occured with num_blocks" + !write(*,*) num_blocks + !result of num_blocks is 4 + + ! + !allocate the blocklist array + ! + ALLOCATE(blocklist(num_blocks*RANK*2), STAT= error) + if(error .NE. 0) then + STOP + endif + + ! + !get the list of hyperslabs selected in the current dataspac selection + ! + CALL h5sget_select_hyper_blocklist_f(dataspace, startblock, & + num_blocks, blocklist, error) + CALL check("h5sget_select_hyper_blocklist_f", error, total_error) + !write(*,*) (blocklist(i), i =1, num_blocks*RANK*2) + !result of blocklist selected is: + !1, 1, 2, 2, 4, 1, 5, 2, 1, 4, 2, 5, 4, 4, 5, 5 + + ! + !deallocate the blocklist array + ! + DEALLOCATE(blocklist) + + ! + !get the selection bounds in the current dataspac selection + ! + CALL h5sget_select_bounds_f(dataspace, startout, endout, error) + CALL check("h5sget_select_bounds_f", error, total_error) + IF ( (startout(1) .ne. 1) .or. (startout(2) .ne. 1) ) THEN + write(*,*) "error occured to select_bounds's start position" + END IF + + IF ( (endout(1) .ne. 5) .or. (endout(2) .ne. 5) ) THEN + write(*,*) "error occured to select_bounds's end position" + END IF + !write(*,*) (startout(i), i = 1, RANK) + !result of startout is 0, 0 + + !write(*,*) (endout(i), i = 1, RANK) + !result of endout is 5, 5 + + ! + !allocate the pointlist array + ! +! ALLOCATE(pointlist(num_blocks*RANK), STAT= error) + ALLOCATE(pointlist(20), STAT= error) + if(error .NE. 0) then + STOP + endif + + ! + !Select the elements in file space + ! + CALL h5sselect_elements_f(dataspace, H5S_SELECT_SET_F, RANK, NUMPS,& + coord, error) + CALL check("h5sselect_elements_f", error, total_error) + + ! + !Get the number of selected elements + ! + CALL h5sget_select_elem_npoints_f(dataspace, num_points, error) + CALL check("h5sget_select_elem_npoints_f", error, total_error) + IF (num_points .NE. 10) write(*,*) "error occured with num_points" + !write(*,*) num_points + ! result of num_points is 10 + + ! + !Get the list of selected elements + ! + num1_points = num_points + CALL h5sget_select_elem_pointlist_f(dataspace, startpoint, & + num1_points, pointlist, error) + CALL check("h5sget_select_elem_pointlist_f", error, total_error) + !write(*,*) (pointlist(i), i =1, num1_points*RANK) + !result of pintlist is: + !1, 1, 3, 1, 5, 1, 1, 3, 3, 3, 5, 3, 3, + !4, 1, 4, 3, 5, 5, 5 + + ! + !deallocate the pointlist array + ! + DEALLOCATE(pointlist) + + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f", error, total_error) + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + + END SUBROUTINE test_basic_select + + diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 new file mode 100644 index 0000000..2b6301b --- /dev/null +++ b/fortran/test/tH5T.f90 @@ -0,0 +1,691 @@ + SUBROUTINE compoundtest(total_error) +! +! This program creates a dataset that is one dimensional array of +! structures { +! character*2 +! integer +! double precision +! real +! } +! Data is written and read back by fields. +! +! The following H5T interface functions are tested: +! h5tcopy_f, h5tset(get)_size_f, h5tcreate_f, h5tinsert_f, h5tclose_f, +! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f, +! h5tequal_f, h5tinsert_array_f, h5tcommit_f + + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=11), PARAMETER :: filename = "compound.h5" ! File name + CHARACTER(LEN=8), PARAMETER :: dsetname = "Compound" ! Dataset name + INTEGER, PARAMETER :: dimsize = 6 ! Size of the dataset + INTEGER, PARAMETER :: COMP_NUM_MEMBERS = 4 ! Number of members in the compound datatype + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dspace_id ! Dataspace identifier + INTEGER(HID_T) :: dtype_id ! Compound datatype identifier + INTEGER(HID_T) :: dtarray_id ! Compound datatype identifier + INTEGER(HID_T) :: dt1_id ! Memory datatype identifier (for character field) + INTEGER(HID_T) :: dt2_id ! Memory datatype identifier (for integer field) + INTEGER(HID_T) :: dt3_id ! Memory datatype identifier (for double precision field) + INTEGER(HID_T) :: dt4_id ! Memory datatype identifier (for real field) + INTEGER(HID_T) :: dt5_id ! Memory datatype identifier + INTEGER(HID_T) :: membtype_id ! Datatype identifier + INTEGER(HID_T) :: plist_id ! Dataset trasfer property + + + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/dimsize/) ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + + INTEGER :: error ! Error flag + INTEGER(SIZE_T) :: type_size ! Size of the datatype + INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(SIZE_T) :: offset ! Member's offset + INTEGER(SIZE_T) :: offset_out ! Member's offset + CHARACTER*2, DIMENSION(dimsize) :: char_member + CHARACTER*2, DIMENSION(dimsize) :: char_member_out ! Buffer to read data out + INTEGER, DIMENSION(dimsize) :: int_member + INTEGER, DIMENSION(dimsize) :: int_member_out + DOUBLE PRECISION, DIMENSION(dimsize) :: double_member + DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out + REAL, DIMENSION(dimsize) :: real_member + REAL, DIMENSION(dimsize) :: real_member_out + INTEGER :: i + INTEGER :: class ! Datatype class + INTEGER :: num_members ! Number of members in the compound datatype + CHARACTER*256 :: member_name + INTEGER :: len ! Lenght of the name of the compound datatype member + LOGICAL :: flag + INTEGER(SIZE_T), DIMENSION(3) :: array_dims=(/2,3,4/) + INTEGER :: elements = 24 ! number of elements in the array_dims array. + INTEGER(SIZE_T) :: sizechar + ! + ! Initialize data buffer. + ! + do i = 1, dimsize + char_member(i)(1:1) = char(65+i) + char_member(i)(2:2) = char(65+i) + char_member_out(i)(1:1) = char(65) + char_member_out(i)(2:2) = char(65) + int_member(i) = i + int_member_out(i) = 0 + double_member(i) = 2.* i + double_member_out(i) = 0. + real_member(i) = 3. * i + real_member_out(i) = 0. + enddo + + ! + ! Initialize FORTRAN predefined datatypes. + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f", error, total_error) + ! + ! Set dataset transfer property to preserve partially initialized fields + ! during write/read to/from dataset with compound datatype. + ! + CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) + CALL check("h5pcreate_f", error, total_error) + CALL h5pset_preserve_f(plist_id, 1, error) + CALL check("h5pset_preserve_f", error, total_error) + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f", error, total_error) + + ! + ! Create the dataspace. + ! + CALL h5screate_simple_f(rank, dims, dspace_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! Create compound datatype. + ! + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error) + CALL check("h5tcopy_f", error, total_error) + sizechar = 2 + CALL h5tset_size_f(dt5_id, sizechar, error) + CALL check("h5tset_size_f", error, total_error) + CALL h5tget_size_f(dt5_id, type_sizec, error) + CALL check("h5tget_size_f", error, total_error) + CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error) + CALL check("h5tget_size_f", error, total_error) + CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error) + CALL check("h5tget_size_f", error, total_error) + CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, error) + CALL check("h5tget_size_f", error, total_error) + !write(*,*) "get sizes", type_sizec, type_sizei, type_sizer, type_sized + type_size = type_sizec + type_sizei + type_sized + type_sizer + CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, error) + CALL check("h5tcreate_f", error, total_error) + ! + ! Insert memebers + ! + ! CHARACTER*2 memeber + ! + offset = 0 + CALL h5tinsert_f(dtype_id, "char_field", offset, dt5_id, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! INTEGER member + ! + offset = offset + type_sizec ! Offset of the second memeber is 2 + CALL h5tinsert_f(dtype_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! DOUBLE PRECISION member + ! + offset = offset + type_sizei ! Offset of the third memeber is 6 + CALL h5tinsert_f(dtype_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! REAL member + ! + offset = offset + type_sized ! Offset of the last member is 14 + CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error) + CALL check("h5tinsert_f", error, total_error) + + ! + ! Create the dataset with compound datatype. + ! + CALL h5dcreate_f(file_id, dsetname, dtype_id, dspace_id, & + dset_id, error) + CALL check("h5dcreate_f", error, total_error) + ! + ! Create memory types. We have to create a compound datatype + ! for each member we want to write. + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dt1_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt1_id, "char_field", offset, dt5_id, error) + CALL check("h5tinsert_f", error, total_error) + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt2_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt2_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) + CALL check("h5tinsert_f", error, total_error) + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) + CALL check("h5tinsert_f", error, total_error) + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! Write data by fields in the datatype. Fields order is not important. + ! + CALL h5dwrite_f(dset_id, dt4_id, real_member, error, xfer_prp = plist_id) + CALL check("h5dwrite_f", error, total_error) + CALL h5dwrite_f(dset_id, dt1_id, char_member, error, xfer_prp = plist_id) + CALL check("h5dwrite_f", error, total_error) + CALL h5dwrite_f(dset_id, dt3_id, double_member, error, xfer_prp = plist_id) + CALL check("h5dwrite_f", error, total_error) + CALL h5dwrite_f(dset_id, dt2_id, int_member, error, xfer_prp = plist_id) + CALL check("h5dwrite_f", error, total_error) + + ! + ! End access to the dataset and release resources used by it. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + + ! + ! Terminate access to the data space. + ! + CALL h5sclose_f(dspace_id, error) + CALL check("h5sclose_f", error, total_error) + ! + ! Terminate access to the datatype + ! + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt1_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt2_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt3_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt4_id, error) + CALL check("h5tclose_f", error, total_error) +! We will keep this type open +! CALL h5tclose_f(dt5_id, error) +! CALL check("h5tclose_f", error, total_error) + + ! + ! Create and store compound datatype with the character and + ! array members. + ! + type_size = type_sizec + elements*type_sizer ! Size of compound datatype + CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtarray_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dtarray_id, "char_field", offset, H5T_NATIVE_CHARACTER, error) + offset = type_sizec + CALL h5tinsert_array_f(dtarray_id, "array_filed", offset, size(array_dims), & + array_dims, H5T_NATIVE_REAL, error) + CALL check("h5tinsert_array_f", error, total_error) + CALL h5tcommit_f(file_id, "Compound_with_array_member", dtarray_id, error) + CALL check("h5tcommit_f", error, total_error) + CALL h5tclose_f(dtarray_id, error) + CALL check("h5tclose_f", error, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + + ! + ! Open the file. + ! + CALL h5fopen_f (filename, H5F_ACC_RDWR_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + ! + ! Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f", error, total_error) + ! + ! Get datatype of the open dataset. + ! Check it class, number of members, and member's names. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f", error, total_error) + CALL h5tget_class_f(dtype_id, class, error) + CALL check("h5dget_class_f", error, total_error) + if (class .ne. H5T_COMPOUND_F) then + write(*,*) " Wrong class type returned" + total_error = total_error + 1 + endif + CALL h5tget_nmembers_f(dtype_id, num_members, error) + CALL check("h5dget_nmembers_f", error, total_error) + if (num_members .ne. COMP_NUM_MEMBERS ) then + write(*,*) " Wrong number of members returned" + total_error = total_error + 1 + endif + ! + ! Go through the members and find out their names and offsets. + ! + do i = 1, num_members + CALL h5tget_member_name_f(dtype_id, i-1, member_name, len, error) + CALL check("h5tget_member_name_f", error, total_error) + CALL h5tget_member_offset_f(dtype_id, i-1, offset_out, error) + CALL check("h5tget_member_offset_f", error, total_error) + CHECK_NAME: SELECT CASE (member_name(1:len)) + CASE("char_field") + if(offset_out .ne. 0) then + write(*,*) "Offset of the char member is incorrect" + total_error = total_error + 1 + endif + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, dt5_id, flag, error) + CALL check("h5tequal_f", error, total_error) + if(.not. flag) then + write(*,*) "Wrong member type returned for character member" + total_error = total_error + 1 + endif + CASE("integer_field") + if(offset_out .ne. type_sizec) then + write(*,*) "Offset of the integer member is incorrect" + total_error = total_error + 1 + endif + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_INTEGER, flag, error) + CALL check("h5tequal_f", error, total_error) + if(.not. flag) then + write(*,*) "Wrong member type returned for integer memebr" + total_error = total_error + 1 + endif + CASE("double_field") + if(offset_out .ne. (type_sizec+type_sizei)) then + write(*,*) "Offset of the double precision member is incorrect" + total_error = total_error + 1 + endif + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_DOUBLE, flag, error) + CALL check("h5tequal_f", error, total_error) + if(.not. flag) then + write(*,*) "Wrong member type returned for double precision memebr" + total_error = total_error + 1 + endif + CASE("real_field") + if(offset_out .ne. (type_sizec+type_sizei+type_sized)) then + write(*,*) "Offset of the real member is incorrect" + total_error = total_error + 1 + endif + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_REAL, flag, error) + CALL check("h5tequal_f", error, total_error) + if(.not. flag) then + write(*,*) "Wrong member type returned for real memebr" + total_error = total_error + 1 + endif + CASE DEFAULT + write(*,*) "Wrong member's name" + total_error = total_error + 1 + + END SELECT CHECK_NAME + + enddo + ! + ! Create memory datatype to read character member of the compound datatype. + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt2_id, error) + CALL check("h5tcopy_f", error, total_error) + sizechar = 2 + CALL h5tset_size_f(dt2_id, sizechar, error) + CALL check("h5tset_size_f", error, total_error) + CALL h5tget_size_f(dt2_id, type_size, error) + CALL check("h5tget_size_f", error, total_error) + CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dt1_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt1_id, "char_field", offset, dt2_id, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! Read part of the dataset + ! + CALL h5dread_f(dset_id, dt1_id, char_member_out, error) + CALL check("h5dread_f", error, total_error) + do i = 1, dimsize + if (char_member_out(i) .ne. char_member(i)) then + write(*,*) " Wrong character data is read back " + total_error = total_error + 1 + endif + enddo + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt5_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt5_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! Read part of the dataset + ! + CALL h5dread_f(dset_id, dt5_id, int_member_out, error) + CALL check("h5dread_f", error, total_error) + do i = 1, dimsize + if (int_member_out(i) .ne. int_member(i)) then + write(*,*) " Wrong integer data is read back " + total_error = total_error + 1 + endif + enddo + ! + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! Read part of the dataset + ! + CALL h5dread_f(dset_id, dt3_id, double_member_out, error) + CALL check("h5dread_f", error, total_error) + do i = 1, dimsize + if (double_member_out(i) .ne. double_member(i)) then + write(*,*) " Wrong double precision data is read back " + total_error = total_error + 1 + endif + enddo + ! + ! + CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) + CALL check("h5tcreate_f", error, total_error) + offset = 0 + CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) + CALL check("h5tinsert_f", error, total_error) + ! + ! Read part of the dataset + ! + CALL h5dread_f(dset_id, dt4_id, real_member_out, error) + CALL check("h5dread_f", error, total_error) + do i = 1, dimsize + if (real_member_out(i) .ne. real_member(i)) then + write(*,*) " Wrong double precision data is read back " + total_error = total_error + 1 + endif + enddo + ! + + ! + ! Close all open objects. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5tclose_f(dt1_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt2_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt3_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt4_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dt5_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + ! + ! Close FORTRAN predefined datatypes. + ! +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + + RETURN + END SUBROUTINE compoundtest + + + + + SUBROUTINE basic_data_type_test(total_error) +!THis subroutine tests following functionalities: +!H5tget_precision_f, H5tset_precision_f, H5tget_offset_f +!H5tset_offset_f, H5tget_pad_f, H5tset_pad_f, H5tget_sign_f, +!H5tset_sign_f, H5tget_ebias_f,H5tset_ebias_f, H5tget_norm_f, +!H5tset_norm_f, H5tget_inpad_f, H5tset_inpad_f, H5tget_cset_f, +!H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=13), PARAMETER :: filename = "basic_type.h5" ! File name + + INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id + ! datatype identifiers + INTEGER(SIZE_T) :: precision ! Datatype precision + INTEGER(SIZE_T) :: setprecision ! Datatype precision + INTEGER(SIZE_T) :: offset ! Datatype offset + INTEGER(SIZE_T) :: setoffset ! Datatype offset + INTEGER :: lsbpad !padding type of the least significant bit + INTEGER :: msbpad !padding type of the most significant bit + INTEGER :: sign !sign type for an integer type + INTEGER(SIZE_T) :: ebias1 !Datatype exponent bias of a floating-point type + INTEGER(SIZE_T) :: ebias2 !Datatype exponent bias of a floating-point type + INTEGER(SIZE_T) :: setebias + INTEGER :: norm !mantissa normalization of a floating-point datatype + INTEGER :: inpad !padding type for unused bits in floating-point datatypes. + INTEGER :: cset !character set type of a string datatype + INTEGER :: strpad !string padding method for a string datatype + INTEGER :: error !error flag + ! + ! Initialize FORTRAN predefined datatypes + ! +! CALL h5init_types_f(error) +! CALL check("h5init_types_f",error,total_error) + + + ! + ! Create a datatype + ! + CALL h5tcopy_f(H5T_STD_U16BE, dtype1_id, error) + CALL check("h5tcopy_f",error,total_error) + ! + !datatype type_id should be modifiable after h5tcopy_f + ! + setprecision = 12 + CALL h5tset_precision_f(dtype1_id, setprecision, error) + CALL check("h5set_precision_f",error,total_error) + CALL h5tget_precision_f(dtype1_id,precision, error) + CALL check("h5get_precision_f",error,total_error) + if(precision .ne. 12) then + write (*,*) "got precision is not correct" + total_error = total_error + 1 + end if + + CALL h5tcopy_f(H5T_STD_I32LE, dtype2_id, error) + CALL check("h5tcopy_f",error,total_error) + setprecision = 12 + CALL h5tset_precision_f(dtype2_id, setprecision, error) + CALL check("h5set_precision_f",error,total_error) + + setoffset = 2 + CALL h5tset_offset_f(dtype1_id, setoffset, error) + CALL check("h5set_offset_f",error,total_error) + setoffset = 10 + CALL h5tset_offset_f(dtype2_id, setoffset, error) + CALL check("h5set_offset_f",error,total_error) + CALL h5tget_offset_f(dtype2_id,offset, error) + CALL check("h5get_offset_f",error,total_error) + if(offset .ne. 10) then + write (*,*) "got offset is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_pad_f(dtype2_id,H5T_PAD_ONE_F, H5T_PAD_ONE_F, error) + CALL check("h5set_pad_f",error,total_error) + CALL h5tget_pad_f(dtype2_id,lsbpad,msbpad, error) + CALL check("h5get_pad_f",error,total_error) + if((lsbpad .ne. H5T_PAD_ONE_F) .and. (msbpad .ne. H5T_PAD_ONE_F)) then + write (*,*) "got pad is not correct" + total_error = total_error + 1 + end if + +! CALL h5tset_sign_f(dtype2_id,H5T_SGN_2_F, error) +! CALL check("h5set_sign_f",error,total_error) +! CALL h5tget_sign_f(dtype2_id,sign, error) + CALL h5tget_sign_f(H5T_NATIVE_INTEGER, sign, error) + CALL check("h5tget_sign_f",error,total_error) + if(sign .ne. H5T_SGN_2_F ) then + write (*,*) "got sign is not correct" + total_error = total_error + 1 + end if + + CALL h5tcopy_f(H5T_IEEE_F64BE, dtype3_id, error) + CALL check("h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_IEEE_F32LE, dtype4_id, error) + CALL check("h5tcopy_f",error,total_error) + + setebias = 257 + CALL h5tset_ebias_f(dtype3_id, setebias, error) + CALL check("h5tset_ebias_f",error,total_error) + setebias = 1 + CALL h5tset_ebias_f(dtype4_id, setebias, error) + CALL check("h5tset_ebias_f",error,total_error) + CALL h5tget_ebias_f(dtype3_id, ebias1, error) + CALL check("h5tget_ebias_f",error,total_error) + if(ebias1 .ne. 257 ) then + write (*,*) "got ebias is not correct" + total_error = total_error + 1 + end if + CALL h5tget_ebias_f(dtype4_id, ebias2, error) + CALL check("h5tget_ebias_f",error,total_error) + if(ebias2 .ne. 1 ) then + write (*,*) "got ebias is not correct" + total_error = total_error + 1 + end if + + !attention: + !It seems that I can't use H5T_NORM_IMPLIED_F to set the norm value + !because I got error for the get_norm function +! CALL h5tset_norm_f(dtype3_id,H5T_NORM_IMPLIED_F , error) +! CALL check("h5tset_norm_f",error,total_error) +! CALL h5tget_norm_f(dtype3_id, norm, error) +! CALL check("h5tget_norm_f",error,total_error) +! if(norm .ne. H5T_NORM_IMPLIED_F ) then +! write (*,*) "got norm is not correct" +! total_error = total_error + 1 +! end if + CALL h5tset_norm_f(dtype3_id, H5T_NORM_MSBSET_F , error) + CALL check("h5tset_norm_f",error,total_error) + CALL h5tget_norm_f(dtype3_id, norm, error) + CALL check("h5tget_norm_f",error,total_error) + if(norm .ne. H5T_NORM_MSBSET_F ) then + write (*,*) "got norm is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_norm_f(dtype3_id, H5T_NORM_NONE_F , error) + CALL check("h5tset_norm_f",error,total_error) + CALL h5tget_norm_f(dtype3_id, norm, error) + CALL check("h5tget_norm_f",error,total_error) + if(norm .ne. H5T_NORM_NONE_F ) then + write (*,*) "got norm is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_inpad_f(dtype3_id, H5T_PAD_ZERO_F , error) + CALL check("h5tset_inpad_f",error,total_error) + CALL h5tget_inpad_f(dtype3_id, inpad , error) + CALL check("h5tget_inpad_f",error,total_error) + if(inpad .ne. H5T_PAD_ZERO_F ) then + write (*,*) "got inpad is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_inpad_f(dtype3_id,H5T_PAD_ONE_F , error) + CALL check("h5tset_inpad_f",error,total_error) + CALL h5tget_inpad_f(dtype3_id, inpad , error) + CALL check("h5tget_inpad_f",error,total_error) + if(inpad .ne. H5T_PAD_ONE_F ) then + write (*,*) "got inpad is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_inpad_f(dtype3_id,H5T_PAD_BACKGROUND_F , error) + CALL check("h5tset_inpad_f",error,total_error) + CALL h5tget_inpad_f(dtype3_id, inpad , error) + CALL check("h5tget_inpad_f",error,total_error) + if(inpad .ne. H5T_PAD_BACKGROUND_F ) then + write (*,*) "got inpad is not correct" + total_error = total_error + 1 + end if + +! we should not apply h5tset_cset_f to non_character data typemake + +! CALL h5tset_cset_f(dtype4_id, H5T_CSET_ASCII_F, error) +! CALL check("h5tset_cset_f",error,total_error) +! CALL h5tget_cset_f(dtype4_id, cset, error) +! CALL check("h5tget_cset_f",error,total_error) +! if(cset .ne. H5T_CSET_ASCII_F ) then +! write (*,*) "got cset is not correct" +! total_error = total_error + 1 +! end if + + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dtype5_id, error) + CALL check("h5tcopy_f",error,total_error) + CALL h5tset_cset_f(dtype5_id, H5T_CSET_ASCII_F, error) + CALL check("h5tset_cset_f",error,total_error) + CALL h5tget_cset_f(dtype5_id, cset, error) + CALL check("h5tget_cset_f",error,total_error) + if(cset .ne. H5T_CSET_ASCII_F ) then + write (*,*) "got cset is not correct" + total_error = total_error + 1 + end if + CALL h5tset_strpad_f(dtype5_id, H5T_STR_NULL_F, error) + CALL check("h5tset_strpad_f",error,total_error) + CALL h5tget_strpad_f(dtype5_id, strpad, error) + CALL check("h5tget_strpad_f",error,total_error) + if(strpad .ne. H5T_STR_NULL_F ) then + write (*,*) "got strpad is not correct" + total_error = total_error + 1 + end if + + CALL h5tset_strpad_f(dtype5_id, H5T_STR_SPACE_F, error) + CALL check("h5tset_strpad_f",error,total_error) + CALL h5tget_strpad_f(dtype5_id, strpad, error) + CALL check("h5tget_strpad_f",error,total_error) + if(strpad .ne. H5T_STR_SPACE_F ) then + write (*,*) "got strpad is not correct" + total_error = total_error + 1 + end if + + CALL h5tclose_f(dtype1_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dtype2_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dtype3_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dtype4_id, error) + CALL check("h5tclose_f", error, total_error) + CALL h5tclose_f(dtype5_id, error) + CALL check("h5tclose_f", error, total_error) + +! CALL h5close_types_f(error) +! CALL check("h5close_types_f", error, total_error) + + RETURN + END SUBROUTINE basic_data_type_test |