Skip to content

Commit da75396

Browse files
committed
h5 % open() add ok= option
logical true if OK.
1 parent 0ae0021 commit da75396

File tree

2 files changed

+34
-9
lines changed

2 files changed

+34
-9
lines changed

src/interface.f90

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -657,7 +657,7 @@ module function id2name(id)
657657
character(:), allocatable :: id2name
658658
end function
659659

660-
module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug)
660+
module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32, debug, ok)
661661
!! open/create file
662662
!!
663663
!! PARAMETERS:
@@ -673,6 +673,8 @@ module subroutine h5open(self, filename, action, comp_lvl, shuffle, fletcher32,
673673
logical, intent(in), optional :: shuffle
674674
logical, intent(in), optional :: fletcher32
675675
logical, intent(in), optional :: debug
676+
logical, intent(out), optional :: ok
677+
676678
end subroutine
677679

678680
module subroutine h5close(self, close_hdf5_interface)
@@ -768,10 +770,11 @@ module integer(HSIZE_T) function hdf_filesize(self)
768770
class(hdf5_file), intent(in) :: self
769771
end function
770772

771-
module pure subroutine estop(ier, id, filename, obj_name, attr_name)
773+
module pure subroutine estop(ier, id, filename, obj_name, attr_name, ok)
772774
integer, intent(in) :: ier
773775
character(*), intent(in) :: id, filename
774776
character(*), intent(in), optional :: obj_name, attr_name
777+
logical, intent(inout), optional :: ok
775778
end subroutine
776779

777780
end interface

src/utils.f90

Lines changed: 29 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,10 @@
4040
integer(HID_T) :: fapl !< file access property list
4141
integer :: file_mode
4242

43+
if(present(ok)) ok = .true.
44+
4345
if(self%is_open()) then
44-
write(stderr,*) 'h5fortran:open: file handle already open: '//self%filename
46+
write(stderr, '(a)') 'NOTICE:h5fortran:open: file handle already open: '//self%filename
4547
return
4648
endif
4749

@@ -76,15 +78,21 @@
7678
if (.not. hdf5_is_initialized()) then
7779
if(self%debug) print '(a)', 'TRACE:h5fortran:h5open: initializing HDF5 library'
7880
call H5open_f(ier)
79-
call estop(ier, 'h5open:H5open HDF5 library initialize', filename)
81+
call estop(ier, 'h5open:H5open HDF5 library initialize', filename, ok=ok)
82+
if (present(ok)) then
83+
if (.not. ok) return
84+
endif
8085
endif
8186

8287
if(self%debug) then
8388
call H5Eset_auto_f(1, ier)
8489
else
8590
call H5Eset_auto_f(0, ier)
8691
endif
87-
call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', filename)
92+
call estop(ier, 'h5open:H5Eset_auto: HDF5 library set traceback', filename, ok=ok)
93+
if (present(ok)) then
94+
if(.not. ok) return
95+
endif
8896

8997
select case(laction)
9098
case('r')
@@ -100,7 +108,11 @@
100108
case ('w')
101109
file_mode = H5F_ACC_TRUNC_F
102110
case default
103-
error stop 'ERROR:h5fortran:open Unsupported action ' // laction // ' for ' // filename
111+
call estop(ier, 'ERROR:h5fortran:open Unsupported action ' // laction, filename, ok=ok)
112+
if (present(ok)) then
113+
if(.not. ok) return
114+
endif
115+
104116
end select
105117

106118
fapl = H5P_DEFAULT_F
@@ -117,10 +129,16 @@
117129
error stop "ERROR:h5fortran:open: action=" // laction // " not an HDF5 file: " // filename
118130
endif
119131
call H5Fopen_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
120-
call estop(ier, "h5open:H5Fopen", filename)
132+
call estop(ier, "h5open:H5Fopen", filename, ok=ok)
133+
if (present(ok)) then
134+
if(.not. ok) return
135+
endif
121136
elseif(file_mode == H5F_ACC_TRUNC_F) then
122137
call H5Fcreate_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
123-
call estop(ier, "h5open:H5Fcreate", filename)
138+
call estop(ier, "h5open:H5Fcreate", filename, ok=ok)
139+
if (present(ok)) then
140+
if(.not. ok) return
141+
endif
124142
else
125143
error stop "ERROR:h5fortran:open: Unsupported file mode: " // filename
126144
endif
@@ -408,7 +426,11 @@
408426
write(bufi, "(i0)") ier
409427
buf = trim(buf) // trim(filename) // " code=" // trim(bufi)
410428

411-
error stop trim(buf)
429+
if(present(ok)) then
430+
ok = .false.
431+
else
432+
error stop trim(buf)
433+
endif
412434

413435
end procedure estop
414436

0 commit comments

Comments
 (0)