diff options
Diffstat (limited to 'hl/fortran/test')
| -rw-r--r-- | hl/fortran/test/Dependencies | 3 | ||||
| -rw-r--r-- | hl/fortran/test/Makefile.in | 70 | ||||
| -rwxr-xr-x | hl/fortran/test/tstimage.f90 | 316 | ||||
| -rw-r--r-- | hl/fortran/test/tstlite.f90 | 955 | ||||
| -rwxr-xr-x | hl/fortran/test/tsttable.f90 | 435 |
5 files changed, 1779 insertions, 0 deletions
diff --git a/hl/fortran/test/Dependencies b/hl/fortran/test/Dependencies new file mode 100644 index 0000000..f29a269 --- /dev/null +++ b/hl/fortran/test/Dependencies @@ -0,0 +1,3 @@ +## This file is machine generated on GNU systems. +## Only temporary changes may be made here. + diff --git a/hl/fortran/test/Makefile.in b/hl/fortran/test/Makefile.in new file mode 100644 index 0000000..2e41ab4 --- /dev/null +++ b/hl/fortran/test/Makefile.in @@ -0,0 +1,70 @@ +## +## Copyright by the Board of Trustees of the University of Illinois. +## All rights reserved. +## +## This file is part of HDF5. The full HDF5 copyright notice, including +## terms governing use, modification, and redistribution, is contained in +## the files COPYING and Copyright.html. COPYING can be found at the root +## of the source code distribution tree; Copyright.html can be found at the +## root level of an installed copy of the electronic HDF5 document set and +## is linked from the top-level documents page. It can also be found at +## http://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have +## access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. +## +## HDF5-Fortran test/Makefile(.in) +## +top_srcdir=@top_srcdir@ +top_builddir=../../.. +srcdir=@srcdir@ +@COMMENCE@ + +HDF_FORTRAN="yes" + +hdf5_srcdir=$(top_srcdir)/src +hdf5_builddir=$(top_builddir)/src +CPPFLAGS=-I. -I$(hdf5_builddir) -I$(hdf5_srcdir) @CPPFLAGS@ + +## Add include directory to the C preprocessor flags and the h5test and hdf5 +## libraries to the library list. +## C hdf5 +HDF5LIB=$(top_srcdir)/src/libhdf5.la +## fortran hdf5 +FLIB=$(top_srcdir)/fortran/src/libhdf5_fortran.la +## C hl +HL_LIB=$(top_srcdir)/hl/src/libhdf5_hl.la +## fortran hl +HL_FLIB=$(top_srcdir)/hl/fortran/src/libhdf5hl_fortran.la + + +TCLIB= +LIB_CSRC= +LIB_FSRC= +LIB_OBJ=$(LIB_FSRC:.f90=.lo) $(LIB_CSRC:.c=.lo) + +TEST_PROGS_SRC=tstlite.f90 tstimage.f90 tsttable.f90 +TEST_PROGS=$(TEST_PROGS_SRC:.f90=) + +# fortranlib_test settting +FORTLIBTEST_FSRC= +FORTLIBTEST_CSRC= +FORTLIBTEST_OBJ=$(FORTLIBTEST_FSRC:.f90=.lo) $(FORTLIBTEST_CSRC:.c=.lo) + +TEST_OBJ=$(FORTLIBTEST_OBJ) $(TEST_PROGS_SRC:.f90=.lo) + +## Temporary files +MOSTLYCLEAN=*.h5 *.tmp + +$(TEST_PROGS): $(LIB) $(FLIB) $(HL_LIB) $(HL_FLIB) + +tstlite: tstlite.lo + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ tstlite.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB) + +tstimage: tstimage.lo + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ tstimage.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB) + +tsttable: tsttable.lo + @$(LT_LINK_FEXE) $(FFLAGS) -o $@ tsttable.lo $(HL_LIB) $(HL_FLIB) $(FLIB) $(LIBS) $(HDF5LIB) + + + +@CONCLUDE@ diff --git a/hl/fortran/test/tstimage.f90 b/hl/fortran/test/tstimage.f90 new file mode 100755 index 0000000..444cd60 --- /dev/null +++ b/hl/fortran/test/tstimage.f90 @@ -0,0 +1,316 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source errcode distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! + +program image_test + +call make_image1() + +end program image_test + + +!------------------------------------------------------------------------- +! make_image1 +!------------------------------------------------------------------------- + +subroutine make_image1() + +use H5IM ! module of H5IM +use HDF5 ! module of HDF5 library + +implicit none + +character(len=8), parameter :: filename = "f1img.h5" ! File name +character(LEN=4), parameter :: dsetname1 = "img1" ! Dataset name +character(LEN=4), parameter :: dsetname2 = "img2" ! Dataset name +character(LEN=15), parameter :: il ="INTERLACE_PIXEL"! Dataset name +integer(HID_T) :: file_id ! File identifier +integer(HSIZE_T), parameter :: width = 30 ! width +integer(HSIZE_T), parameter :: height = 10 ! width +integer*1, dimension(width*height) :: buf1 ! Data buffer +integer*1, dimension(width*height) :: bufr1 ! Data buffer +integer*1, dimension(width*height*3) :: buf2 ! Data buffer +integer*1, dimension(width*height*3) :: bufr2 ! Data buffer +integer(HSIZE_T) :: widthr ! width of image +integer(HSIZE_T) :: heightr ! height of image +integer(HSIZE_T) :: planesr ! color planes +integer(HSIZE_T) :: npalsr ! palettes +character(LEN=15) :: interlacer ! interlace +integer :: errcode ! Error flag +integer :: is_image ! Error flag +integer :: i, n ! general purpose integer +! +! palette +! create a 9 entry grey palette +! +character(LEN=4), parameter :: pal_name = "pal1" ! Dataset name +integer(HSIZE_T), dimension(2) :: pal_dims = (/9,3/) ! Dataset dimensions +integer(HSIZE_T), dimension(2) :: pal_dims_out ! Dataset dimensions +integer*1, dimension(9*3) :: pal_data_in = (/0,0,0,25,25,25,50,50,50,75,75,75,100,100,100,& + 125,125,125,125,125,125,125,125,125,125,125,125/) +integer*1, dimension(9*3) :: pal_data_out ! Data buffer +integer(HSIZE_T) :: npals ! number of palettes +integer :: pal_number ! palette number +integer :: is_palette ! is palette + +! +! Initialize the data array. +! +n = 0 +do i = 1, width*height + buf1(i) = n; + n = n + 1; +end do + +n = 0 +do i = 1, width*height*3 + buf2(i) = n; + n = n + 1; +end do + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + +!------------------------------------------------------------------------- +! indexed image +!------------------------------------------------------------------------- + +call test_begin(' Make/Read image 8bit ') + +! +! write image. +! +call h5immake_image_8bit_f(file_id,dsetname1,width,height,buf1,errcode) + +! +! read image. +! +call h5imread_image_f(file_id,dsetname1,bufr1,errcode) + +! +! compare read and write buffers. +! +do i = 1, width*height + if ( buf1(i) .ne. bufr1(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr1(i), ' and ', buf1(i) + stop + endif +end do + +! +! get image info. +! +call h5imget_image_info_f(file_id,dsetname1,widthr,heightr,planesr,interlacer,npalsr,errcode) + +if ( (widthr .ne. widthr) .or. (heightr .ne. height) .or. (planesr .ne. 1)) then + print *, 'h5imget_image_info_f bad value' + stop +endif + +is_image = h5imis_image_f(file_id,dsetname1) +if ( is_image .ne. 1) then + print *, 'h5imis_image_f bad value' + stop +endif + + +call passed() + +!------------------------------------------------------------------------- +! true color image +!------------------------------------------------------------------------- + +call test_begin(' Make/Read image 24bit ') + +! +! write image. +! +call h5immake_image_24bit_f(file_id,dsetname2,width,height,il,buf2,errcode) + +! +! read image. +! +call h5imread_image_f(file_id,dsetname2,bufr2,errcode) + +! +! compare read and write buffers. +! +do i = 1, width*height*3 + if ( buf2(i) .ne. bufr2(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr2(i), ' and ', buf2(i) + stop + endif +end do + +! +! get image info. +! +call h5imget_image_info_f(file_id,dsetname2,widthr,heightr,planesr,interlacer,npalsr,errcode) + +if ( (widthr .ne. widthr) .or. (heightr .ne. height) .or. (planesr .ne. 3)) then + print *, 'h5imget_image_info_f bad value' + stop +endif + +is_image = h5imis_image_f(file_id,dsetname2) +if ( is_image .ne. 1) then + print *, 'h5imis_image_f bad value' + stop +endif + + + +call passed() + +!------------------------------------------------------------------------- +! palette +!------------------------------------------------------------------------- + +call test_begin(' Make palette ') + +! +! make palette. +! +call h5immake_palette_f(file_id,pal_name,pal_dims,pal_data_in,errcode) + +call passed() + + +call test_begin(' Link/Unlink palette ') + +! +! link palette. +! +call h5imlink_palette_f(file_id,dsetname1,pal_name,errcode) + + +! +! read palette. +! +pal_number = 0 +call h5imget_palette_f(file_id,dsetname1,pal_number,pal_data_out,errcode) + +! +! compare read and write buffers. +! +do i = 1, 9*3 + if ( pal_data_in(i) .ne. pal_data_out(i) ) then + print *, 'read buffer differs from write buffer' + print *, pal_data_in(i), ' and ', pal_data_out(i) + stop + endif +end do + +! +! get number of palettes +! +call h5imget_npalettes_f(file_id,dsetname1,npals,errcode) + +if ( npals .ne. 1) then + print *, 'h5imget_npalettes_f bad value' + stop +endif + +! +! get palette info +! +pal_number = 0 +call h5imget_palette_info_f(file_id,dsetname1,pal_number,pal_dims_out,errcode) + +if ( (pal_dims_out(1) .ne. pal_dims(1)) .or. (pal_dims_out(2) .ne. pal_dims(2))) then + print *, 'h5imget_palette_info_f bad value' + stop +endif + +! +! is palette +! +is_palette = h5imis_palette_f(file_id,pal_name) + +if ( is_palette .ne. 1 ) then + print *, 'h5imis_palette_f bad value' + stop +endif + +! +! unlink palette. +! +call h5imunlink_palette_f(file_id,dsetname1,pal_name,errcode) + +! +! get number of palettes +! +call h5imget_npalettes_f(file_id,dsetname1,npals,errcode ) + +if ( npals .ne. 0) then + print *, 'h5imget_npalettes_f bad value' + stop +endif + +call passed() + + +!------------------------------------------------------------------------- +! end +!------------------------------------------------------------------------- + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + + +! +! end function. +! +end subroutine make_image1 + + + + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +subroutine test_begin(string) +character(LEN=*), intent(IN) :: string +write(*, fmt = '(14a)', advance = 'no') string +write(*, fmt = '(40x,a)', advance = 'no') ' ' +end subroutine test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +subroutine passed() +write(*, fmt = '(6a)') 'PASSED' +end subroutine passed diff --git a/hl/fortran/test/tstlite.f90 b/hl/fortran/test/tstlite.f90 new file mode 100644 index 0000000..c172d82 --- /dev/null +++ b/hl/fortran/test/tstlite.f90 @@ -0,0 +1,955 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source errcode distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! + +program lite_test + +call test_dataset1D() +call test_dataset2D() +call test_dataset3D() +call test_datasets() +call test_attributes() + +end program lite_test + + +!------------------------------------------------------------------------- +! test_dataset1D +!------------------------------------------------------------------------- + +subroutine test_dataset1D() + +use H5LT ! module of H5LT +use HDF5 ! module of HDF5 library + +implicit none + +integer, parameter :: DIM1 = 4; ! Dimension of array +character(len=9), parameter :: filename = "dsetf1.h5"! File name +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name +character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name +integer(HID_T) :: file_id ! File identifier +integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions +integer :: rank = 1 ! Dataset rank +integer, dimension(DIM1) :: buf1 ! Data buffer +integer, dimension(DIM1) :: bufr1 ! Data buffer +real, dimension(DIM1) :: buf2 ! Data buffer +real, dimension(DIM1) :: bufr2 ! Data buffer +double precision, dimension(DIM1) :: buf3 ! Data buffer +double precision, dimension(DIM1) :: bufr3 ! Data buffer +integer :: errcode ! Error flag +integer :: i ! general purpose integer + + +call test_begin(' Make/Read datasets (1D) ') + + +! +! Initialize the data array. +! +do i = 1, DIM1 + buf1(i) = i; + buf2(i) = i; + buf3(i) = i; +end do + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INTEGER +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf1(i) .ne. bufr1(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr1(i), ' and ', buf1(i) + stop + endif +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf2(i) .ne. bufr2(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr2(i), ' and ', buf2(i) + stop + endif +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf3(i) .ne. bufr3(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr3(i), ' and ', buf3(i) + stop + endif +end do + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +call passed() +! +! end function. +! +end subroutine test_dataset1D + +!------------------------------------------------------------------------- +! test_dataset2D +!------------------------------------------------------------------------- + +subroutine test_dataset2D() + +use H5LT ! module of H5LT +use HDF5 ! module of HDF5 library + +implicit none + + +integer, parameter :: DIM1 = 4; ! columns +integer, parameter :: DIM2 = 6; ! rows +character(len=9), parameter :: filename = "dsetf2.h5"! File name +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name +character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name +character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name +integer(HID_T) :: file_id ! File identifier +integer(HSIZE_T), dimension(2) :: dims = (/4,6/) ! Dataset dimensions +integer :: rank = 2 ! Dataset rank +integer, dimension(DIM1*DIM2) :: buf ! Data buffer +integer, dimension(DIM1*DIM2) :: bufr ! Data buffer +integer, dimension(DIM1,DIM2) :: buf2 ! Data buffer +integer, dimension(DIM1,DIM2) :: buf2r ! Data buffer +real, dimension(DIM1,DIM2) :: buf3 ! Data buffer +real, dimension(DIM1,DIM2) :: buf3r ! Data buffer +double precision, dimension(DIM1,DIM2) :: buf4 ! Data buffer +double precision, dimension(DIM1,DIM2) :: buf4r ! Data buffer +integer :: errcode ! Error flag +integer :: i, j, n ! general purpose integers + +call test_begin(' Make/Read datasets (2D) ') + + +! +! Initialize the data arrays. +! +n=1 +do i = 1, DIM1*DIM2 + buf(i) = n; + n = n + 1 +end do + +do i = 1, dims(1) + do j = 1, dims(2) + buf2(i,j) = (i-1)*dims(2) + j; + buf3(i,j) = (i-1)*dims(2) + j; + buf4(i,j) = (i-1)*dims(2) + j; + end do +end do + + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 1D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1*DIM2 + if ( buf(i) .ne. bufr(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr(i), ' and ', buf(i) + stop + endif +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 2D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + if ( buf2(i,j) .ne. buf2r(i,j) ) then + print *, 'read buffer differs from write buffer' + print *, buf2r(i,j), ' and ', buf2(i,j) + stop + endif + end do +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + if ( buf3(i,j) .ne. buf3r(i,j) ) then + print *, 'read buffer differs from write buffer' + print *, buf3r(i,j), ' and ', buf3(i,j) + stop + endif + end do +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + if ( buf4(i,j) .ne. buf4r(i,j) ) then + print *, 'read buffer differs from write buffer' + print *, buf4r(i,j), ' and ', buf4(i,j) + stop + endif + end do +end do + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +call passed() +! +! end function. +! +end subroutine test_dataset2D + + +!------------------------------------------------------------------------- +! test_dataset3D +!------------------------------------------------------------------------- + + +subroutine test_dataset3D() + +use H5LT ! module of H5LT +use HDF5 ! module of HDF5 library + +implicit none + +integer, parameter :: DIM1 = 6; ! columns +integer, parameter :: DIM2 = 4; ! rows +integer, parameter :: DIM3 = 2; ! layers +character(len=9), parameter :: filename = "dsetf3.h5" ! File name +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name +character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name +character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name +integer(HID_T) :: file_id ! File identifier +integer(HSIZE_T), dimension(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions +integer, dimension(DIM1*DIM2*DIM3) :: buf ! Data buffer +integer, dimension(DIM1*DIM2*DIM3) :: bufr ! Data buffer +integer, dimension(DIM1,DIM2,DIM3) :: buf2 ! Data buffer +integer, dimension(DIM1,DIM2,DIM3) :: buf2r ! Data buffer +real, dimension(DIM1,DIM2,DIM3) :: buf3 ! Data buffer +real, dimension(DIM1,DIM2,DIM3) :: buf3r ! Data buffer +double precision, dimension(DIM1,DIM2,DIM3) :: buf4 ! Data buffer +double precision, dimension(DIM1,DIM2,DIM3) :: buf4r ! Data buffer +integer :: rank = 3 ! Dataset rank +integer :: errcode ! Error flag +integer :: i, j, k, n ! general purpose integers + +call test_begin(' Make/Read datasets (3D) ') + + +! +! Initialize the data array. +! +n=1 +do i = 1, DIM1*DIM2*DIM3 + buf(i) = n; + n = n + 1 +end do + +n = 1 +do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + buf2(i,j,k) = n; + buf3(i,j,k) = n; + buf4(i,j,k) = n; + n = n + 1 + end do + end do +end do + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 1D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1*DIM2*DIM3 + if ( buf(i) .ne. bufr(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr(i), ' and ', buf(i) + stop + endif +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_INT 3D buffer +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + if ( buf2(i,j,k) .ne. buf2r(i,j,k) ) then + print *, 'read buffer differs from write buffer' + print *, buf2r(i,j,k), ' and ', buf2(i,j,k) + stop + endif + end do + end do +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_REAL +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + if ( buf3(i,j,k) .ne. buf3r(i,j,k) ) then + print *, 'read buffer differs from write buffer' + print *, buf3r(i,j,k), ' and ', buf3(i,j,k) + stop + endif + end do + end do +end do + +!------------------------------------------------------------------------- +! H5T_NATIVE_DOUBLE +!------------------------------------------------------------------------- + +! +! write dataset. +! +call h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode) + +! +! read dataset. +! +call h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, dims(1) + do j = 1, dims(2) + do k = 1, dims(3) + if ( buf4(i,j,k) .ne. buf4r(i,j,k) ) then + print *, 'read buffer differs from write buffer' + print *, buf4r(i,j,k), ' and ', buf4(i,j,k) + stop + endif + end do + end do +end do + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +call passed() +! +! end function. +! +end subroutine test_dataset3D + + + +!------------------------------------------------------------------------- +! test_datasets +!------------------------------------------------------------------------- + +subroutine test_datasets() + +use H5LT ! module of H5LT +use HDF5 ! module of HDF5 library + +implicit none + +character(len=9), parameter :: filename = "dsetf4.h5"! File name +integer(HID_T) :: file_id ! File identifier +integer :: errcode ! Error flag +integer, parameter :: DIM1 = 10; ! Dimension of array +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +character(LEN=5), parameter :: dsetname2 = "dset2" ! Dataset name +character(LEN=5), parameter :: dsetname3 = "dset3" ! Dataset name +character(LEN=5), parameter :: dsetname4 = "dset4" ! Dataset name +integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions +integer(HSIZE_T), dimension(1) :: dimsr ! Dataset dimensions +integer :: rank = 1 ! Dataset rank +integer :: rankr ! Dataset rank +character(LEN=8), parameter :: buf1 = "mystring" ! Data buffer +character(LEN=8) :: buf1r ! Data buffer +integer, dimension(DIM1) :: buf2 ! Data buffer +integer, dimension(DIM1) :: bufr2 ! Data buffer +real, dimension(DIM1) :: buf3 ! Data buffer +real, dimension(DIM1) :: bufr3 ! Data buffer +double precision, dimension(DIM1) :: buf4 ! Data buffer +double precision, dimension(DIM1) :: bufr4 ! Data buffer +integer :: i, n ! general purpose integer +integer :: has ! general purpose integer +integer :: type_class +integer(SIZE_T) :: type_size + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + +! +! Initialize the data array. +! +n = 1 +do i = 1, DIM1 + buf2(i) = n; + buf3(i) = n; + buf4(i) = n; + n = n + 1; +end do + +!------------------------------------------------------------------------- +! int +!------------------------------------------------------------------------- + +call test_begin(' Make/Read datasets (integer) ') + +! +! write dataset. +! +call h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode) + +! +! read dataset. +! +call h5ltread_dataset_int_f(file_id, dsetname2, bufr2, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf2(i) .ne. bufr2(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr2(i), ' and ', buf2(i) + stop + endif +end do + +call passed() + +!------------------------------------------------------------------------- +! real +!------------------------------------------------------------------------- + +call test_begin(' Make/Read datasets (float) ') + + +! +! write dataset. +! +call h5ltmake_dataset_float_f(file_id, dsetname3, rank, dims, buf3, errcode) + +! +! read dataset. +! +call h5ltread_dataset_float_f(file_id, dsetname3, bufr3, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf3(i) .ne. bufr3(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr3(i), ' and ', buf3(i) + stop + endif +end do + +call passed() + +!------------------------------------------------------------------------- +! double +!------------------------------------------------------------------------- + +call test_begin(' Make/Read datasets (double) ') + + +! +! write dataset. +! +call h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode) + +! +! read dataset. +! +call h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf4(i) .ne. bufr4(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr4(i), ' and ', buf4(i) + stop + endif +end do + +call passed() + +call test_begin(' Get dataset dimensions ') + +!------------------------------------------------------------------------- +! h5ltget_dataset_ndims_f +!------------------------------------------------------------------------- + +call h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) + +if ( rankr .ne. rank ) then + print *, 'h5ltget_dataset_ndims_f return error' + stop +endif + +call passed() + +!------------------------------------------------------------------------- +! test find dataset function +!------------------------------------------------------------------------- + +call test_begin(' Find dataset ') + + +has = h5ltfind_dataset_f(file_id,dsetname4) +if ( has .ne. 1 ) then + print *, 'h5ltfind_dataset_f return error' + stop +endif + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +call passed() +! +! end function. +! +end subroutine test_datasets + + + +!------------------------------------------------------------------------- +! test_attributes +!------------------------------------------------------------------------- + +subroutine test_attributes() + +use H5LT ! module of H5LT +use HDF5 ! module of HDF5 library + +implicit none + +character(len=9), parameter :: filename = "dsetf4.h5"! File name +integer(HID_T) :: file_id ! File identifier +integer, parameter :: DIM1 = 10; ! Dimension of array +character(LEN=5), parameter :: attrname1 = "attr1" ! Attribute name +character(LEN=5), parameter :: attrname2 = "attr2" ! Attribute name +character(LEN=5), parameter :: attrname3 = "attr3" ! Attribute name +character(LEN=5), parameter :: attrname4 = "attr4" ! Attribute name +character(LEN=8), parameter :: buf1 = "mystring" ! Data buffer +character(LEN=8) :: bufr1 ! Data buffer +integer, dimension(DIM1) :: buf2 ! Data buffer +integer, dimension(DIM1) :: bufr2 ! Data buffer +real, dimension(DIM1) :: buf3 ! Data buffer +real, dimension(DIM1) :: bufr3 ! Data buffer +double precision, dimension(DIM1) :: buf4 ! Data buffer +double precision, dimension(DIM1) :: bufr4 ! Data buffer +integer :: errcode ! Error flag +integer :: i, n ! general purpose integer +integer(SIZE_T) size ! size of attribute array +integer :: rankr ! rank +integer(HSIZE_T), dimension(1) :: dimsr ! attribute dimensions +integer :: type_class +integer(SIZE_T) :: type_size +integer(HSIZE_T), dimension(1) :: dims = (/DIM1/) ! Dataset dimensions +integer :: rank = 1 ! Dataset rank +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +integer, dimension(DIM1) :: buf ! Data buffer + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) +! +! make a dataset. +! +call h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode) + +! +! Initialize the data array. +! +size = DIM1 +n = 1 +do i = 1, DIM1 + buf2(i) = n; + buf3(i) = n; + buf4(i) = n; + n = n + 1; +end do + + +!------------------------------------------------------------------------- +! int +!------------------------------------------------------------------------- + +call test_begin(' Set/Get attributes int ') + + +! +! write attribute. +! +call h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode) + +! +! read attribute. +! +call h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf2(i) .ne. bufr2(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr2(i), ' and ', buf2(i) + stop + endif +end do + +call passed() + +!------------------------------------------------------------------------- +! float +!------------------------------------------------------------------------- + +call test_begin(' Set/Get attributes float ') + + +! +! write attribute. +! +call h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode) + +! +! read attribute. +! +call h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf3(i) .ne. bufr3(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr3(i), ' and ', buf3(i) + stop + endif +end do + + +call passed() + +!------------------------------------------------------------------------- +! double +!------------------------------------------------------------------------- + +call test_begin(' Set/Get attributes double ') + + +! +! write attribute. +! +call h5ltset_attribute_double_f(file_id,dsetname1,attrname4,buf4,size,errcode) + +! +! read attribute. +! +call h5ltget_attribute_double_f(file_id,dsetname1,attrname4,bufr4,errcode) + +! +! compare read and write buffers. +! +do i = 1, DIM1 + if ( buf4(i) .ne. bufr4(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufr4(i), ' and ', buf4(i) + stop + endif +end do + +call passed() + + +!------------------------------------------------------------------------- +! get attribute rank +!------------------------------------------------------------------------- + +call test_begin(' Get attribute rank ') + + +call h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode) + +if ( rankr .ne. 1 ) then + print *, 'h5ltget_attribute_ndims_f return error' + stop +endif + + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + +call passed() +! +! end function. +! +end subroutine test_attributes + + + + + + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +subroutine test_begin(string) +character(LEN=*), intent(IN) :: string +write(*, fmt = '(14a)', advance = 'no') string +write(*, fmt = '(40x,a)', advance = 'no') ' ' +end subroutine test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +subroutine passed() +write(*, fmt = '(6a)') 'PASSED' +end subroutine passed
\ No newline at end of file diff --git a/hl/fortran/test/tsttable.f90 b/hl/fortran/test/tsttable.f90 new file mode 100755 index 0000000..2f27d3c --- /dev/null +++ b/hl/fortran/test/tsttable.f90 @@ -0,0 +1,435 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source errcode distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains the FORTRAN90 tests for H5LT +! + +program table_test + +call test_table1() + + +end program table_test + + +!------------------------------------------------------------------------- +! test_table1 +!------------------------------------------------------------------------- + +subroutine test_table1() + +use H5TB ! module of H5TB +use HDF5 ! module of HDF5 library + +implicit none + +character(len=8), parameter :: filename = "f1tab.h5" ! File name +character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name +integer(HID_T) :: file_id ! File identifier +integer(HSIZE_T), parameter :: nfields = 4; ! nfields +integer(HSIZE_T), parameter :: nrecords = 5; ! nrecords +character(LEN=6), dimension(nfields) :: field_names ! field names +integer(SIZE_T), dimension(nfields) :: field_offset ! field offset +integer(HID_T), dimension(nfields) :: field_types ! field types +integer(HSIZE_T), parameter :: chunk_size = 5 ! chunk size +integer, parameter :: compress = 0 ! compress +integer :: errcode ! Error flag +integer :: i ! general purpose integer +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(HID_T) :: type_id_c ! Memory datatype identifier (for character field) +integer(SIZE_T) :: offset ! Member's offset +integer(HSIZE_T) :: start ! start record +integer, dimension(nrecords) :: bufi ! Data buffer +integer, dimension(nrecords) :: bufir ! Data buffer +real, dimension(nrecords) :: bufr ! Data buffer +real, dimension(nrecords) :: bufrr ! Data buffer +double precision, dimension(nrecords) :: bufd ! Data buffer +double precision, dimension(nrecords) :: bufdr ! Data buffer +character(LEN=2), dimension(nrecords), parameter :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer +character(LEN=2), dimension(nrecords) :: bufsr ! Data buffer +integer(HSIZE_T) :: nfieldsr ! nfields +integer(HSIZE_T) :: nrecordsr ! nrecords +character(LEN=6), dimension(nfields) :: field_namesr ! field names +integer(SIZE_T), dimension(nfields) :: field_offsetr ! field offset +integer(SIZE_T), dimension(nfields) :: field_sizesr ! field sizes +integer(SIZE_T) :: type_sizeout ! size of the datatype + + +! +! Initialize the data arrays. +! +do i = 1, nrecords + bufi(i) = i; + bufr(i) = i; + bufd(i) = i; +end do + +! +! Initialize FORTRAN predefined datatypes. +! +call h5open_f(errcode) + +! +! Create a new file using default properties. +! +call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + +!------------------------------------------------------------------------- +! make table +! initialize the table parameters +!------------------------------------------------------------------------- + +field_names(1) = "field1" +field_names(2) = "field2" +field_names(3) = "field3" +field_names(4) = "field4" + +! +! calculate total size by calculating sizes of each member +! +call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) +type_size = 2 +call h5tset_size_f(type_id_c, type_size, errcode) +call h5tget_size_f(type_id_c, type_sizec, errcode) +call h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) +call h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) +call h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) +type_size = type_sizec + type_sizei + type_sized + type_sizer + +! +! type ID's +! +field_types(1) = type_id_c +field_types(2) = H5T_NATIVE_INTEGER +field_types(3) = H5T_NATIVE_DOUBLE +field_types(4) = H5T_NATIVE_REAL + +! +! offsets +! +offset = 0 +field_offset(1) = offset +offset = offset + type_sizec ! Offset of the second memeber is 2 +field_offset(2) = offset +offset = offset + type_sizei ! Offset of the second memeber is 6 +field_offset(3) = offset +offset = offset + type_sized ! Offset of the second memeber is 14 +field_offset(4) = offset + +!------------------------------------------------------------------------- +! make table +!------------------------------------------------------------------------- + +call test_begin(' Make table ') + + +call h5tbmake_table_f(dsetname1,& + file_id,& + dsetname1,& + nfields,& + nrecords,& + type_size,& + field_names,& + field_offset,& + field_types,& + chunk_size,& + compress,& + errcode ) + +call passed() + +!------------------------------------------------------------------------- +! write field +!------------------------------------------------------------------------- + +call test_begin(' Read/Write field by name ') + +call h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufs,errcode) + +call h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufi,errcode) + +call h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufd,errcode) + +call h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufr,errcode) + + + +!------------------------------------------------------------------------- +! read field +!------------------------------------------------------------------------- + +call h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufsr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufsr(i) .ne. bufs(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufsr(i), ' and ', bufs(i) + stop + endif +end do + +call h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufir,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufir(i) .ne. bufi(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufir(i), ' and ', bufi(i) + stop + endif +end do + +call h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufdr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufdr(i) .ne. bufd(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufdr(i), ' and ', bufd(i) + stop + endif +end do + +call h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufrr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufrr(i) .ne. bufr(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufrr(i), ' and ', bufr(i) + stop + endif +end do + + +call passed() + + +!------------------------------------------------------------------------- +! write field +!------------------------------------------------------------------------- + +call test_begin(' Read/Write field by index ') + +call h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufs,errcode) + +call h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufi,errcode) + +call h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufd,errcode) + +call h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufr,errcode) + + + +!------------------------------------------------------------------------- +! read field +!------------------------------------------------------------------------- + +call h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufsr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufsr(i) .ne. bufs(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufsr(i), ' and ', bufs(i) + stop + endif +end do + +call h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufir,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufir(i) .ne. bufi(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufir(i), ' and ', bufi(i) + stop + endif +end do + +call h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufdr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufdr(i) .ne. bufd(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufdr(i), ' and ', bufd(i) + stop + endif +end do + +call h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufrr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufrr(i) .ne. bufr(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufrr(i), ' and ', bufr(i) + stop + endif +end do + + +call passed() + + +!------------------------------------------------------------------------- +! Insert field +! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) +!------------------------------------------------------------------------- + +call test_begin(' Insert field ') + +call h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) + +call h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& + bufrr,errcode) + +! +! compare read and write buffers. +! +do i = 1, nrecords + if ( bufrr(i) .ne. bufr(i) ) then + print *, 'read buffer differs from write buffer' + print *, bufrr(i), ' and ', bufr(i) + stop + endif +end do + +call passed() + + +!------------------------------------------------------------------------- +! Delete field +!------------------------------------------------------------------------- + +call test_begin(' Delete field ') + +call h5tbdelete_field_f(file_id,dsetname1,"field4",errcode) + +call passed() + + +!------------------------------------------------------------------------- +! Gets the number of records and fields +!------------------------------------------------------------------------- + +call test_begin(' Get table info ') + +call h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) + +if ( nfieldsr .ne. nfields .and. nrecordsr .ne. nrecords ) then + print *, 'h5tbget_table_info_f return error' + stop +endif + +call passed() + + +!------------------------------------------------------------------------- +! Get information about fields +!------------------------------------------------------------------------- + +!call test_begin(' Get fields info ') + +!call h5tbget_field_info_f(file_id,dsetname1,nfields,field_namesr,field_sizesr,& +! field_offsetr,type_sizeout,errcode ) + + +!call passed() + + + +!------------------------------------------------------------------------- +! end +!------------------------------------------------------------------------- + +! +! Close the file. +! +call h5fclose_f(file_id, errcode) + +! +! Close FORTRAN predefined datatypes. +! +call h5close_f(errcode) + + +! +! end function. +! +end subroutine test_table1 + + + + + +!------------------------------------------------------------------------- +! test_begin +!------------------------------------------------------------------------- + +subroutine test_begin(string) +character(LEN=*), intent(IN) :: string +write(*, fmt = '(14a)', advance = 'no') string +write(*, fmt = '(40x,a)', advance = 'no') ' ' +end subroutine test_begin + +!------------------------------------------------------------------------- +! passed +!------------------------------------------------------------------------- + +subroutine passed() +write(*, fmt = '(6a)') 'PASSED' +end subroutine passed + + |