14 integer(HID_T):: fid=0, gid=0
19 procedure:: group_open
27 procedure,
private:: ints
28 procedure,
private:: ints_1d
29 procedure,
private:: ints_2d
30 procedure,
private:: ints_3d
31 procedure,
private:: ints_4d
32 procedure,
private:: real
33 procedure,
private:: real_1d
34 procedure,
private:: real_2d
35 procedure,
private:: real_3d
36 procedure,
private:: real_4d
37 generic,
public:: output => ints, ints_1d, ints_2d, ints_3d, ints_4d, &
38 real, real_1d, real_2d, real_3d, real_4d
40 type(
h5_t),
public:: h5
46 INTEGER(HID_T) FUNCTION open (self, name, new, verbose)
result (fid)
48 character(len=*):: name
49 logical,
optional:: new
50 integer,
optional:: verbose
53 call h5open_f (self%err)
54 inquire (file=name, exist=exists)
56 call h5fopen_f (name, h5f_acc_rdwr_f, fid, self%err)
58 call h5fcreate_f (name, h5f_acc_excl_f, fid, self%err)
61 if (
present(new))
then 64 if (
present(verbose)) &
65 self%verbose = verbose
66 if (self%verbose > 1) &
67 print *,
'open ', trim(name), exists, self%err
73 SUBROUTINE close (self, id)
77 call h5fclose_f (id, self%err)
78 call h5close_f (self%err)
79 if (self%verbose > 1) &
80 print *,
'close', self%err
86 INTEGER(HID_T) FUNCTION group_open (self, id, name, new)
result (gid)
89 character(len=*):: name
90 logical,
optional:: new
91 integer::
type, links, corder
94 call h5lexists_f (id, name, exists, self%err)
96 call h5gopen_f (id, name, gid, self%err)
98 call h5gcreate_f (id, name, gid, self%err)
101 if (
present(new))
then 104 if (self%verbose > 1) &
105 print *,
'group_open ', name, new, self%err
106 END FUNCTION group_open
111 INTEGER(HID_T) FUNCTION set_open (self, id, name, a, new)
result (did)
113 integer(HID_T):: id, sid
114 character(len=*):: name
116 integer::
type, links, corder
117 logical,
optional:: new
120 call h5lexists_f (id, name, exists, self%err)
122 call h5dopen_f (id, name, did, self%err)
124 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
125 call h5dcreate_f (id, name, h5t_native_real, sid, did, self%err)
127 if (
present(new))
then 130 if (self%verbose > 1) &
131 print *,
'set_open ', name, exists, self%err
132 END FUNCTION set_open
137 SUBROUTINE set_write (self, id, a)
142 call h5dwrite_f (id, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
143 if (self%verbose > 1) &
144 print *,
'set_write', shape(a), self%err
145 END SUBROUTINE set_write
150 SUBROUTINE set_close (self, id)
154 call h5dclose_f (id, self%err)
155 if (self%verbose > 1) &
156 print *,
'set_close', self%err
157 END SUBROUTINE set_close
162 INTEGER(HID_T) FUNCTION att_open (self, id, name, a, new)
result (did)
164 integer(HID_T):: id, sid
165 character(len=*):: name
167 integer::
type, links, corder
168 logical,
optional:: new
171 call h5aexists_f (id, name, exists, self%err)
173 call h5aopen_f (id, name, did, self%err)
175 call h5screate_simple_f (1, shape(a,kind=hsize_t), sid, self%err)
176 call h5acreate_f (id, name, h5t_native_real, sid, did, self%err)
178 if (
present(new))
then 181 if (self%verbose > 1) &
182 print *,
'att_open ', name, exists, self%err
183 END FUNCTION att_open
188 SUBROUTINE att_write (self, id, a)
193 call h5awrite_f (id, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
194 if (self%verbose > 1) &
195 print *,
'att_write', shape(a), self%err
196 END SUBROUTINE att_write
201 SUBROUTINE att_close (self, id)
205 call h5aclose_f (id, self%err)
206 if (self%verbose > 1) &
207 print *,
'att_close', self%err
208 END SUBROUTINE att_close
213 LOGICAL FUNCTION exists (self, sequence, record, name, id, attribute)
215 character(len=*) :: sequence, name
217 character(len=6) :: srecord
219 logical,
optional:: attribute
221 if (self%fid == 0)
then 222 self%fid = self%open (trim(io_unit%outputname)//
'/hdf5.dat')
224 write (srecord,
'(i6.6)') record
225 id = self%group_open (self%group_open (self%fid, sequence), srecord)
226 if (
present(attribute))
then 227 call h5aexists_f (id, name, exists, self%err)
229 call h5lexists_f (id, name, exists, self%err)
234 SUBROUTINE ints (self, seq, record, name, a)
236 character(len=*) :: seq, name
239 integer(HID_T) :: id, sid, did, rank(1)
241 if (self%exists(seq, record, name, id, attribute=.true.))
then 242 call h5aopen_f (id, name, did, self%err)
245 call h5screate_simple_f (
size(rank), rank, sid, self%err)
246 call h5acreate_f (id, name, h5t_native_integer, sid, did, self%err)
248 call h5awrite_f (did, h5t_native_integer, a, rank, self%err)
249 if (self%verbose > 1) &
250 print *,
'h5_t%ints: attribute =', name, a, self%err
251 call h5aclose_f (did, self%err)
254 SUBROUTINE ints_1d (self, seq, record, name, a)
256 character(len=*) :: seq, name
259 integer(HID_T) :: id, sid, did
261 if (self%exists(seq, record, name, id))
then 262 call h5dopen_f (id, name, did, self%err)
264 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
265 call h5dcreate_f (id, name, h5t_native_integer, sid, did, self%err)
267 call h5dwrite_f (did, h5t_native_integer, a, shape(a,kind=hsize_t), self%err)
268 call h5dclose_f (did, self%err)
269 END SUBROUTINE ints_1d
271 SUBROUTINE ints_2d (self, seq, record, name, a)
273 character(len=*) :: seq, name
276 integer(HID_T) :: id, sid, did
278 if (self%exists(seq, record, name, id))
then 279 call h5dopen_f (id, name, did, self%err)
281 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
282 call h5dcreate_f (id, name, h5t_native_integer, sid, did, self%err)
284 call h5dwrite_f (did, h5t_native_integer, a, shape(a,kind=hsize_t), self%err)
285 call h5dclose_f (did, self%err)
286 END SUBROUTINE ints_2d
288 SUBROUTINE ints_3d (self, seq, record, name, a)
290 character(len=*) :: seq, name
293 integer(HID_T) :: id, sid, did
295 if (self%exists(seq, record, name, id))
then 296 call h5dopen_f (id, name, did, self%err)
298 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
299 call h5dcreate_f (id, name, h5t_native_integer, sid, did, self%err)
301 call h5dwrite_f (did, h5t_native_integer, a, shape(a,kind=hsize_t), self%err)
302 call h5dclose_f (did, self%err)
303 END SUBROUTINE ints_3d
305 SUBROUTINE ints_4d (self, seq, record, name, a)
307 character(len=*) :: seq, name
309 integer :: a(:,:,:,:)
310 integer(HID_T) :: id, sid, did
312 if (self%exists(seq, record, name, id))
then 313 call h5dopen_f (id, name, did, self%err)
315 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
316 call h5dcreate_f (id, name, h5t_native_integer, sid, did, self%err)
318 call h5dwrite_f (did, h5t_native_integer, a, shape(a,kind=hsize_t), self%err)
319 call h5dclose_f (did, self%err)
320 END SUBROUTINE ints_4d
323 SUBROUTINE real (self, seq, record, name, a)
325 character(len=*) :: seq, name
328 integer(HID_T) :: id, sid, did, rank(1)
330 if (self%exists(seq, record, name, id, attribute=.true.))
then 331 call h5aopen_f (id, name, did, self%err)
334 call h5screate_simple_f (
size(rank), rank, sid, self%err)
335 call h5acreate_f (id, name, h5t_native_real, sid, did, self%err)
337 call h5awrite_f (did, h5t_native_real, a, rank, self%err)
338 if (self%verbose > 1) &
339 print *,
'h5_t%real: attribute =', name, a, self%err
340 call h5aclose_f (did, self%err)
343 SUBROUTINE real_1d (self, seq, record, name, a)
345 character(len=*) :: seq, name
348 integer(HID_T) :: id, sid, did
350 if (self%exists(seq, record, name, id))
then 351 call h5dopen_f (id, name, did, self%err)
353 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
354 call h5dcreate_f (id, name, h5t_native_real, sid, did, self%err)
356 call h5dwrite_f (did, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
357 call h5dclose_f (did, self%err)
358 END SUBROUTINE real_1d
360 SUBROUTINE real_2d (self, seq, record, name, a)
362 character(len=*) :: seq, name
365 integer(HID_T) :: id, sid, did
367 if (self%exists(seq, record, name, id))
then 368 call h5dopen_f (id, name, did, self%err)
370 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
371 call h5dcreate_f (id, name, h5t_native_real, sid, did, self%err)
373 call h5dwrite_f (did, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
374 call h5dclose_f (did, self%err)
375 END SUBROUTINE real_2d
377 SUBROUTINE real_3d (self, seq, record, name, a)
379 character(len=*) :: seq, name
382 integer(HID_T) :: id, sid, did
384 if (self%exists(seq, record, name, id))
then 385 call h5dopen_f (id, name, did, self%err)
387 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
388 call h5dcreate_f (id, name, h5t_native_real, sid, did, self%err)
390 call h5dwrite_f (did, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
391 call h5dclose_f (did, self%err)
392 END SUBROUTINE real_3d
394 SUBROUTINE real_4d (self, seq, record, name, a)
396 character(len=*) :: seq, name
399 integer(HID_T) :: id, sid, did
401 if (self%exists(seq, record, name, id))
then 402 call h5dopen_f (id, name, did, self%err)
404 call h5screate_simple_f (
SIZE(shape(a)), shape(a,kind=hsize_t), sid, self%err)
405 call h5dcreate_f (id, name, h5t_native_real, sid, did, self%err)
407 call h5dwrite_f (did, h5t_native_real, a, shape(a,kind=hsize_t), self%err)
408 call h5dclose_f (did, self%err)
409 END SUBROUTINE real_4d
Module interface to the HDF5 library.
The lock module uses nested locks, to allow versatile use of locks, where a procedure may want to mak...