From a149c1f886b8b4563b0ce47f03fb3ecf9bf07352 Mon Sep 17 00:00:00 2001 From: Michael Hirsch Date: Mon, 13 Jul 2020 02:01:53 -0400 Subject: [PATCH] add %ndims %rank method --- .github/workflows/ci_linux.yml | 4 +- .github/workflows/ci_linux_meson.yml | 2 +- .github/workflows/ci_mac.yml | 2 +- .github/workflows/ci_mac_meson.yml | 2 +- CMakeLists.txt | 2 +- Examples.md | 17 +++++++++ meson.build | 2 +- setup.cmake | 6 +++ src/interface.f90 | 6 +++ src/read.f90 | 22 ++++++++--- src/tests/test_lt.f90 | 55 ++++++++++------------------ src/tests/test_minimal.f90 | 4 +- src/tests/test_scalar.f90 | 46 ++++++++--------------- src/tests/test_shape.f90 | 15 +++++--- 14 files changed, 100 insertions(+), 85 deletions(-) diff --git a/.github/workflows/ci_linux.yml b/.github/workflows/ci_linux.yml index 0cc37ca6..2e17d262 100644 --- a/.github/workflows/ci_linux.yml +++ b/.github/workflows/ci_linux.yml @@ -3,7 +3,7 @@ name: ci_linux on: push: paths: - - "**.txt" + - "**/CMakeLists.txt" - "**.cmake" - "**.f90" - ".github/workflows/ci_linux.yml" @@ -22,4 +22,4 @@ jobs: sudo apt update -yq sudo apt install -yq --no-install-recommends gfortran libhdf5-dev - - run: ctest -S setup.cmake -V + - run: ctest -S setup.cmake -VV diff --git a/.github/workflows/ci_linux_meson.yml b/.github/workflows/ci_linux_meson.yml index 660cb647..a7ec25ed 100644 --- a/.github/workflows/ci_linux_meson.yml +++ b/.github/workflows/ci_linux_meson.yml @@ -3,7 +3,7 @@ name: ci_linux_meson on: push: paths: - - "**.build" + - "**/meson.build" - ".github/workflows/ci_linux_meson.yml" diff --git a/.github/workflows/ci_mac.yml b/.github/workflows/ci_mac.yml index 8029b585..370ac8c2 100644 --- a/.github/workflows/ci_mac.yml +++ b/.github/workflows/ci_mac.yml @@ -3,7 +3,7 @@ name: ci_mac on: push: paths: - - "**.txt" + - "**/CMakeLists.txt" - "**.cmake" - ".github/workflows/ci_mac.yml" diff --git a/.github/workflows/ci_mac_meson.yml b/.github/workflows/ci_mac_meson.yml index 187d39b1..0a02d9fb 100644 --- a/.github/workflows/ci_mac_meson.yml +++ b/.github/workflows/ci_mac_meson.yml @@ -3,7 +3,7 @@ name: ci_mac_meson on: push: paths: - - "**.build" + - "**/meson.build" - ".github/workflows/ci_mac_meson.yml" jobs: diff --git a/CMakeLists.txt b/CMakeLists.txt index 748026e8..4c8312b2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ if(NOT CMAKE_BUILD_TYPE) endif() project(h5fortran LANGUAGES C Fortran - VERSION 2.10.0 + VERSION 2.10.1 DESCRIPTION "thin, light object-oriented HDF5 Fortran interface" HOMEPAGE_URL https://github.com/geospace-code/h5fortran) enable_testing() diff --git a/Examples.md b/Examples.md index 299ebcbe..f94a219f 100644 --- a/Examples.md +++ b/Examples.md @@ -71,6 +71,23 @@ A convenience method that checks existance of a dataset without creating the h5 exists = h5exist("my.h5", "/foo") ``` +## check variable shape, rank/ndims + +`h5f%rank == h5f%ndims` for convenience, both methods are equivalent. + +```fortran +call h5f%initialize('test.h5', status='old',action='r') + +integer :: drank +integer(hsize_t), allocatable :: dims(:) + +drank = h5f%rank('/foo') +call h5f%shape('/foo',dims) + +if (drank /= size(dims)) error stop +``` + + ## Read scalar, 3-D array of unknown size ```fortran diff --git a/meson.build b/meson.build index 02a59d9f..9f3be1c7 100644 --- a/meson.build +++ b/meson.build @@ -1,6 +1,6 @@ project('h5fortran', 'fortran', meson_version : '>=0.52.0', - version : '2.10.0', + version : '2.10.1', default_options : ['default_library=static', 'buildtype=release', 'warning_level=3']) subdir('meson') diff --git a/setup.cmake b/setup.cmake index bf6fbeed..f35d2861 100644 --- a/setup.cmake +++ b/setup.cmake @@ -16,6 +16,11 @@ if(NOT DEFINED CTEST_SITE) set(CTEST_SITE ${CMAKE_SYSTEM_NAME}) endif() +# parallel test--use ctest_test(PARALLEL_LEVEL ${Ncpu} as setting CTEST_PARALLEL_LEVEL has no effect +include(ProcessorCount) +ProcessorCount(Ncpu) +message(STATUS "${Ncpu} CPU cores detected") + # test name is Fortran compiler in FC # Note: ctest scripts cannot read cache variables like CMAKE_Fortran_COMPILER if(DEFINED ENV{FC}) @@ -84,6 +89,7 @@ if(return_code EQUAL 0 AND Nerror EQUAL 0 AND cmake_err EQUAL 0) BUILD ${CTEST_BINARY_DIRECTORY} RETURN_VALUE return_code CAPTURE_CMAKE_ERROR ctest_err + PARALLEL_LEVEL ${Ncpu} ) else() message(STATUS "SKIP: ctest_test(): returncode: ${return_code}; CMake error code: ${cmake_err}") diff --git a/src/interface.f90 b/src/interface.f90 index 77bb808d..0801aef9 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -42,6 +42,7 @@ module h5fortran procedure, public :: initialize => hdf_initialize, finalize => hdf_finalize, & write_group, writeattr, & open => hdf_open_group, close => hdf_close_group, & + rank => hdf_get_ndims, ndims => hdf_get_ndims, & shape => hdf_get_shape, layout => hdf_get_layout, chunks => hdf_get_chunk, & exist => hdf_check_exist, exists => hdf_check_exist, & is_contig => hdf_is_contig, is_chunked => hdf_is_chunked @@ -240,6 +241,11 @@ module subroutine hdf_write_7d(self,dname,value, ierr, chunk_size) end subroutine hdf_write_7d +module integer function hdf_get_ndims(self, dname) result (drank) +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +end function hdf_get_ndims + module subroutine hdf_get_shape(self, dname, dims, ierr) class(hdf5_file), intent(in) :: self character(*), intent(in) :: dname diff --git a/src/read.f90 b/src/read.f90 index 70c98e6d..3bf1ae96 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -8,21 +8,33 @@ contains +module procedure hdf_get_ndims +!! get rank or "ndims" +integer :: ier + +drank = -1 + +if (self%exist(dname)) then + call h5ltget_dataset_ndims_f(self%lid, dname, drank, ier) +else + write(stderr, *) 'ERROR:get_shape: ' // dname // ' does not exist in ' // self%filename +endif + +end procedure hdf_get_ndims module procedure hdf_get_shape !! must get dims before info, as "dims" must be allocated or segfault occurs. integer(SIZE_T) :: dsize integer :: dtype, drank, ier -ier = 0 +ier = -1 -if (.not.self%exist(dname)) then +if (self%exist(dname)) then + call h5ltget_dataset_ndims_f(self%lid, dname, drank, ier) +else write(stderr, *) 'ERROR:get_shape: ' // dname // ' does not exist in ' // self%filename - ier = -1 endif -if (ier == 0) call h5ltget_dataset_ndims_f(self%lid, dname, drank, ier) - if (ier == 0) then allocate(dims(drank)) call h5ltget_dataset_info_f(self%lid, dname, dims, dtype, dsize, ier) diff --git a/src/tests/test_lt.f90 b/src/tests/test_lt.f90 index 228fac20..ee54dc6d 100644 --- a/src/tests/test_lt.f90 +++ b/src/tests/test_lt.f90 @@ -10,7 +10,7 @@ module test_lt subroutine test_readwrite_lt(path) character(*), intent(in) :: path -integer :: ierr, L, L1(8), L2(2,1), L3(1,1,1), L4(1,1,1,1), L5(1,1,1,1,1), L6(1,1,1,1,1,1), L7(1,1,1,1,1,1,1) +integer :: L, L1(8), L2(2,1), L3(1,1,1), L4(1,1,1,1), L5(1,1,1,1,1), L6(1,1,1,1,1,1), L7(1,1,1,1,1,1,1) L = 123 L2 = L; L3=L; L4=L; L5=L; L6=L; L7=L @@ -18,54 +18,39 @@ subroutine test_readwrite_lt(path) call h5write(path//'/scalar_int.h5', '/int', 42) -call h5write(path//'/golt.h5', '/int32_0d', 121242, ierr) -if (ierr/=0) error stop 'lt file write' +call h5write(path//'/golt.h5', '/int32_0d', 121242) call h5read(path//'/golt.h5', '/int32_0d', L) if (L /= 121242) error stop 'incorrect read value' ! --- 1d -call h5write(path//'/golt.h5','/int32_1d', [1,2,3,4,5,6], ierr) -if (ierr/=0) error stop 'write 1d error' +call h5write(path//'/golt.h5','/int32_1d', [1,2,3,4,5,6]) L1 = 0 -call h5read(path//'/golt.h5', '/int32_1d', L1(2:7), ierr) -if (ierr/=0) error stop 'read 1d error' +call h5read(path//'/golt.h5', '/int32_1d', L1(2:7)) if(.not. all(L1(2:7) == [1,2,3,4,5,6])) error stop '1d slice read error' ! --- 2d -call h5write(path//'/golt.h5','/int32_2d', L2, ierr) -if (ierr/=0) error stop 'write 2d error' -call h5read(path//'/golt.h5', '/int32_2d', L2, ierr) -if (ierr/=0) error stop 'read 2d error' +call h5write(path//'/golt.h5','/int32_2d', L2) +call h5read(path//'/golt.h5', '/int32_2d', L2) ! --- 3d -call h5write(path//'/golt.h5','/int32_3d', L3, ierr) -if (ierr/=0) error stop 'write 3d error' -call h5read(path//'/golt.h5', '/int32_3d', L3, ierr) -if (ierr/=0) error stop 'read 3d error' - -call h5write(path//'/golt.h5','/int32_4d', L4, ierr) -if (ierr/=0) error stop 'write 4d error' -call h5read(path//'/golt.h5', '/int32_4d', L4, ierr) -if (ierr/=0) error stop 'read 4d error' - -call h5write(path//'/golt.h5','/int32_5d', L5, ierr) -if (ierr/=0) error stop 'write 5d error' -call h5read(path//'/golt.h5', '/int32_5d', L5, ierr) -if (ierr/=0) error stop 'read 5d error' - -call h5write(path//'/golt.h5','/int32_6d', L6, ierr) -if (ierr/=0) error stop 'write 6d error' -call h5read(path//'/golt.h5', '/int32_6d', L6, ierr) -if (ierr/=0) error stop 'read 6d error' - -call h5write(path//'/golt.h5','/int32_7d', L7, ierr) -if (ierr/=0) error stop 'write 7d error' -call h5read(path//'/golt.h5', '/int32_7d', L7, ierr) -if (ierr/=0) error stop 'read 7d error' +call h5write(path//'/golt.h5','/int32_3d', L3) +call h5read(path//'/golt.h5', '/int32_3d', L3) + +call h5write(path//'/golt.h5','/int32_4d', L4) +call h5read(path//'/golt.h5', '/int32_4d', L4) + +call h5write(path//'/golt.h5','/int32_5d', L5) +call h5read(path//'/golt.h5', '/int32_5d', L5) + +call h5write(path//'/golt.h5','/int32_6d', L6) +call h5read(path//'/golt.h5', '/int32_6d', L6) + +call h5write(path//'/golt.h5','/int32_7d', L7) +call h5read(path//'/golt.h5', '/int32_7d', L7) end subroutine test_readwrite_lt diff --git a/src/tests/test_minimal.f90 b/src/tests/test_minimal.f90 index 90f4ec40..a4d2bf85 100644 --- a/src/tests/test_minimal.f90 +++ b/src/tests/test_minimal.f90 @@ -12,7 +12,7 @@ program test_minimal integer :: i,l call get_command_argument(1, argv, length=l, status=i) -if (i /= 0 .or. l == 0) argv = './' +if (i /= 0 .or. l == 0) error stop 'specify path' filename = trim(argv) // '/junk_minimal.h5' print *, 'test path: ', filename @@ -36,4 +36,4 @@ program test_minimal call h5close_f(ierr) if (ierr /= 0) error stop 'could not close hdf5 library' -end program \ No newline at end of file +end program diff --git a/src/tests/test_scalar.f90 b/src/tests/test_scalar.f90 index 01e1f30f..58cc8288 100644 --- a/src/tests/test_scalar.f90 +++ b/src/tests/test_scalar.f90 @@ -18,7 +18,7 @@ subroutine test_scalar_rw(path) integer(int32), allocatable :: i1t(:) integer(HSIZE_T), allocatable :: dims(:) -integer :: i, ierr +integer :: i do i = 1,size(i1) i1(i) = i @@ -26,43 +26,30 @@ subroutine test_scalar_rw(path) r1 = i1 -call h5f%initialize(path//'/test.h5', ierr, status='new',action='w') -if (ierr /= 0) error stop +call h5f%initialize(path//'/test.h5', status='new',action='w') !! scalar tests -call h5f%write('/scalar_int', 42_int32, ierr) -if (ierr /= 0) error stop -call h5f%write('/scalar_real', 42._real32, ierr) -if (ierr /= 0) error stop -call h5f%write('/real1',r1, ierr) -if (ierr /= 0) error stop -call h5f%write('/ai1', i1, ierr) -if (ierr /= 0) error stop -call h5f%finalize(ierr) -if (ierr /= 0) error stop +call h5f%write('/scalar_int', 42_int32) +call h5f%write('/scalar_real', 42._real32) +call h5f%write('/real1',r1) +call h5f%write('/ai1', i1) +call h5f%finalize() -call h5f%initialize(path//'/test.h5', ierr, status='old',action='r') -if (ierr /= 0) error stop -call h5f%read('/scalar_int', it, ierr) -if (ierr /= 0) error stop -call h5f%read('/scalar_real', rt, ierr) -if (ierr /= 0) error stop +call h5f%initialize(path//'/test.h5', status='old',action='r') +call h5f%read('/scalar_int', it) +call h5f%read('/scalar_real', rt) if (.not.(rt==it .and. it==42)) then write(stderr,*) it,'/=',rt error stop 'scalar real / int: not equal 42' endif -call h5f%shape('/real1',dims, ierr) -if (ierr /= 0) error stop +call h5f%shape('/real1',dims) allocate(rr1(dims(1))) -call h5f%read('/real1',rr1, ierr) -if (ierr /= 0) error stop +call h5f%read('/real1',rr1) if (.not.all(r1 == rr1)) error stop 'real 1-D: read does not match write' -call h5f%shape('/ai1',dims, ierr) -if (ierr /= 0) error stop +call h5f%shape('/ai1',dims) allocate(i1t(dims(1))) -call h5f%read('/ai1',i1t, ierr) -if (ierr /= 0) error stop +call h5f%read('/ai1',i1t) if (.not.all(i1==i1t)) error stop 'integer 1-D: read does not match write' if (.not. h5f%filename == path//'/test.h5') then @@ -70,9 +57,8 @@ subroutine test_scalar_rw(path) error stop endif -call h5f%finalize(ierr) -if (ierr /= 0) error stop +call h5f%finalize() end subroutine test_scalar_rw -end module test_scalar \ No newline at end of file +end module test_scalar diff --git a/src/tests/test_shape.f90 b/src/tests/test_shape.f90 index 2f3f868d..bef66f55 100644 --- a/src/tests/test_shape.f90 +++ b/src/tests/test_shape.f90 @@ -5,11 +5,11 @@ program test_shape implicit none (type, external) -type(hdf5_file) :: h5f +type(hdf5_file) :: h character(1024) :: argv character(:), allocatable :: fn, dname integer(HSIZE_T), allocatable :: dims(:) -integer :: ierr +integer :: drank logical :: exists if (command_argument_count() /= 2) error stop "filename dset_name" @@ -26,13 +26,16 @@ program test_shape error stop 77 endif -call h5f%initialize(fn, ierr, status='old', action='r') +call h%initialize(fn, status='old', action='r') -call h5f%shape(dname, dims, ierr) +drank = h%ndims(dname) + +call h%shape(dname, dims) + +if (drank /= size(dims)) error stop 'rank /= size(dims)' print '(/,A,100I8)', 'Fortran dims: ',dims -call h5F%finalize(ierr) -if(ierr/=0) error stop 'finalize' +call h%finalize() end program