add %ndims %rank method

.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

.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"
 
 

.github/workflows/ci_mac.yml

@@ -3,7 +3,7 @@ name: ci_mac
 on:
   push:
     paths:
-      - "**.txt"
+      - "**/CMakeLists.txt"
       - "**.cmake"
       - ".github/workflows/ci_mac.yml"
 

.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:

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()

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

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')

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}")

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

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)

src/tests/test_lt.f90

@@ -10,62 +10,47 @@ 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
 
 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
 

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
+end program

src/tests/test_scalar.f90

@@ -18,61 +18,47 @@ 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
 enddo
 
 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
   write(stderr,*) h5f%filename // ' mismatch filename'
   error stop
 endif
 
-call h5f%finalize(ierr)
-if (ierr /= 0) error stop
+call h5f%finalize()
 
 end subroutine test_scalar_rw
 
-end module test_scalar
+end module test_scalar

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