Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief A wrapper around the HDF5 Fortran API
10 : !> \par History
11 : !> 04.2023 created [SB]
12 : !> \author Stefano Battaglia
13 : ! **************************************************************************************************
14 : MODULE hdf5_wrapper
15 :
16 : #ifdef __HDF5
17 : USE hdf5, ONLY: &
18 : h5aclose_f, h5acreate_f, h5aopen_f, h5aread_f, h5awrite_f, h5close_f, h5dclose_f, &
19 : h5dcreate_f, h5dget_space_f, h5dopen_f, h5dread_f, h5dwrite_f, h5f_acc_rdonly_f, h5f_acc_rdwr_f, &
20 : h5f_acc_trunc_f, h5fclose_f, h5fcreate_f, h5fopen_f, h5gclose_f, h5gcreate_f, h5gopen_f, &
21 : h5open_f, h5s_scalar_f, h5sclose_f, h5screate_f, h5screate_simple_f, &
22 : h5sget_simple_extent_npoints_f, h5t_c_s1, h5t_cset_utf8_f, h5t_enum_f, h5t_native_double, &
23 : h5t_native_integer, h5t_str_nullpad_f, h5t_string, h5tclose_f, h5tcopy_f, h5tcreate_f, &
24 : h5tenum_insert_f, h5tset_cset_f, h5tset_size_f, h5tset_strpad_f, hid_t, hsize_t, size_t
25 : #if defined(__parallel)
26 : USE hdf5, ONLY: h5pcreate_f, h5pclose_f, h5p_file_access_f, h5p_default_f, h5pset_fapl_mpio_f
27 : #endif
28 : #endif
29 : USE iso_c_binding, ONLY: C_LOC, &
30 : C_PTR
31 : USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
32 : USE kinds, ONLY: dp
33 : USE message_passing, ONLY: mp_comm_world, mp_info_null
34 : #include "./base/base_uses.f90"
35 :
36 : IMPLICIT NONE
37 :
38 : PRIVATE
39 :
40 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hdf5_wrapper'
41 : #ifdef __HDF5
42 : INTEGER, PARAMETER, PUBLIC :: hdf5_id = hid_t
43 :
44 : PUBLIC :: h5aread_double_scalar, h5awrite_boolean, h5awrite_double_scalar, h5awrite_double_simple
45 : PUBLIC :: h5awrite_fixlen_string, h5awrite_integer_scalar, h5awrite_integer_simple
46 : PUBLIC :: h5awrite_string_simple, h5close, h5dread_double_simple, h5dwrite_double_simple, h5fclose
47 : PUBLIC :: h5fcreate, h5fopen, h5gclose, h5gcreate, h5gopen, h5open
48 : #endif
49 :
50 : CONTAINS
51 :
52 : #ifdef __HDF5
53 : ! **************************************************************************************************
54 : !> \brief Initialize the HDF5 fortran API
55 : ! **************************************************************************************************
56 4 : SUBROUTINE h5open()
57 : INTEGER :: error
58 :
59 4 : CALL h5open_f(error)
60 4 : IF (error < 0) CPABORT('ERROR: failed to initialize HDF5 interface')
61 :
62 4 : END SUBROUTINE h5open
63 :
64 : ! **************************************************************************************************
65 : !> \brief Close the HDF5 fortran API
66 : ! **************************************************************************************************
67 4 : SUBROUTINE h5close()
68 : INTEGER :: error
69 :
70 4 : CALL h5close_f(error)
71 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 interface')
72 :
73 4 : END SUBROUTINE h5close
74 :
75 : ! **************************************************************************************************
76 : !> \brief Create a HDF5 file
77 : !> \param filename the name of the hdf5 file
78 : !> \param file_id the file id of the hdf5 file
79 : ! **************************************************************************************************
80 12 : SUBROUTINE h5fcreate(filename, file_id)
81 : CHARACTER(LEN=*), INTENT(IN) :: filename
82 : INTEGER(KIND=hid_t), INTENT(OUT) :: file_id
83 :
84 : INTEGER :: error
85 : #if defined(__parallel)
86 : INTEGER(KIND=hid_t) :: plist_id
87 : #endif
88 :
89 : #if defined(__parallel)
90 4 : CALL h5pcreate_f(h5p_file_access_f, plist_id, error)
91 4 : CALL h5pset_fapl_mpio_f(plist_id, mp_comm_world%get_handle(), mp_info_null%get_handle(), error)
92 4 : CALL h5fcreate_f(filename, h5f_acc_trunc_f, file_id, error, access_prp=plist_id)
93 4 : CALL h5pclose_f(plist_id, error)
94 : #else
95 : CALL h5fcreate_f(filename, h5f_acc_trunc_f, file_id, error)
96 : #endif
97 :
98 4 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 file')
99 :
100 4 : END SUBROUTINE h5fcreate
101 :
102 : ! **************************************************************************************************
103 : !> \brief Open a HDF5 file
104 : !> \param filename the name of the hdf5 file
105 : !> \param file_id the file id of the hdf5 file
106 : ! **************************************************************************************************
107 0 : SUBROUTINE h5fopen(filename, file_id)
108 : CHARACTER(LEN=*), INTENT(IN) :: filename
109 : INTEGER(KIND=hid_t), INTENT(OUT) :: file_id
110 :
111 : INTEGER :: error
112 : #if defined(__parallel)
113 : INTEGER(KIND=hid_t) :: plist_id
114 : #endif
115 :
116 : #if defined(__parallel)
117 0 : CALL h5pcreate_f(h5p_file_access_f, plist_id, error)
118 0 : CALL h5pset_fapl_mpio_f(plist_id, mp_comm_world%get_handle(), mp_info_null%get_handle(), error)
119 0 : CALL h5fopen_f(filename, h5f_acc_rdwr_f, file_id, error, access_prp=plist_id)
120 0 : CALL h5pclose_f(plist_id, error)
121 : #else
122 : CALL h5fopen_f(filename, h5f_acc_rdwr_f, file_id, error)
123 : #endif
124 :
125 0 : IF (error < 0) CPABORT('ERROR: failed to open HDF5 file')
126 :
127 0 : END SUBROUTINE h5fopen
128 :
129 : ! **************************************************************************************************
130 : !> \brief Close a HDF5 file
131 : !> \param file_id the file id of the hdf5 file
132 : ! **************************************************************************************************
133 4 : SUBROUTINE h5fclose(file_id)
134 : INTEGER(KIND=hid_t), INTENT(IN) :: file_id
135 :
136 : INTEGER :: error
137 :
138 4 : CALL h5fclose_f(file_id, error)
139 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 file')
140 :
141 4 : END SUBROUTINE h5fclose
142 :
143 : ! **************************************************************************************************
144 : !> \brief Create a HDF5 group
145 : !> \param loc_id file or group identifier
146 : !> \param name name of the group
147 : !> \param grp_id group identifier
148 : ! **************************************************************************************************
149 24 : SUBROUTINE h5gcreate(loc_id, name, grp_id)
150 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
151 : CHARACTER(LEN=*), INTENT(IN) :: name
152 : INTEGER(KIND=hid_t), INTENT(OUT) :: grp_id
153 :
154 : INTEGER :: error
155 :
156 24 : CALL h5gcreate_f(loc_id, name, grp_id, error)
157 24 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 group')
158 :
159 24 : END SUBROUTINE h5gcreate
160 :
161 : ! **************************************************************************************************
162 : !> \brief Open a HDF5 group
163 : !> \param loc_id file or group identifier
164 : !> \param name name of the group
165 : !> \param grp_id group identifier
166 : ! **************************************************************************************************
167 0 : SUBROUTINE h5gopen(loc_id, name, grp_id)
168 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
169 : CHARACTER(LEN=*), INTENT(IN) :: name
170 : INTEGER(KIND=hid_t), INTENT(OUT) :: grp_id
171 :
172 : INTEGER :: error
173 :
174 0 : CALL h5gopen_f(loc_id, name, grp_id, error)
175 0 : IF (error < 0) CPABORT('ERROR: failed to open HDF5 group')
176 :
177 0 : END SUBROUTINE h5gopen
178 :
179 : ! **************************************************************************************************
180 : !> \brief Close a HDF5 group
181 : !> \param grp_id group identifier
182 : ! **************************************************************************************************
183 24 : SUBROUTINE h5gclose(grp_id)
184 : INTEGER(KIND=hid_t), INTENT(IN) :: grp_id
185 :
186 : INTEGER :: error
187 :
188 24 : CALL h5gclose_f(grp_id, error)
189 24 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 group')
190 :
191 24 : END SUBROUTINE h5gclose
192 :
193 : ! **************************************************************************************************
194 : !> \brief Write a variable-length string attribute
195 : !> \param loc_id either file id or group id
196 : !> \param attr_name the name of the attribute
197 : !> \param attr_data the attribute data, i.e. the string to write
198 : ! **************************************************************************************************
199 0 : SUBROUTINE h5awrite_varlen_string(loc_id, attr_name, attr_data)
200 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
201 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
202 : CHARACTER(LEN=*), INTENT(IN), TARGET :: attr_data
203 :
204 : INTEGER :: error, output_unit
205 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
206 : TYPE(c_ptr) :: buffer
207 : TYPE(c_ptr), TARGET :: in_between_ptr
208 :
209 0 : output_unit = cp_logger_get_default_io_unit()
210 :
211 : ! create a scalar dataspace
212 0 : CALL h5screate_f(h5s_scalar_f, space_id, error)
213 0 : IF (error < 0) THEN
214 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
215 0 : ' ERROR: failed to create HDF5 dataspace'
216 0 : RETURN
217 : END IF
218 :
219 : ! create a variable-length string type
220 0 : CALL h5tcopy_f(h5t_string, type_id, error)
221 0 : CALL h5tset_cset_f(type_id, h5t_cset_utf8_f, error)
222 0 : CALL h5tset_strpad_f(type_id, h5t_str_nullpad_f, error)
223 :
224 : ! create the attribute
225 0 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
226 0 : IF (error < 0) THEN
227 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
228 0 : ' ERROR: failed to create HDF5 attribute'
229 0 : RETURN
230 : END IF
231 :
232 : ! weird in-between pointer needed for variable-length
233 : ! string to a scalar dataspace
234 0 : in_between_ptr = C_LOC(attr_data)
235 : ! the actual pointer to be passed
236 0 : buffer = C_LOC(in_between_ptr)
237 :
238 : ! write the string attribute to file
239 0 : CALL h5awrite_f(attr_id, type_id, buffer, error)
240 0 : IF (error < 0) THEN
241 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
242 0 : ' ERROR: failed to write HDF5 attribute'
243 0 : RETURN
244 : END IF
245 :
246 : ! close attribute
247 0 : CALL h5aclose_f(attr_id, error)
248 0 : IF (error < 0) THEN
249 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
250 0 : ' ERROR: failed to close HDF5 attribute'
251 0 : RETURN
252 : END IF
253 :
254 : ! close dataspace
255 0 : CALL h5sclose_f(space_id, error)
256 0 : IF (error < 0) THEN
257 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
258 0 : ' ERROR: failed to close HDF5 dataspace'
259 0 : RETURN
260 : END IF
261 :
262 : ! close datatype
263 0 : CALL h5tclose_f(type_id, error)
264 0 : IF (error < 0) THEN
265 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
266 0 : ' ERROR: failed to close HDF5 datatype'
267 0 : RETURN
268 : END IF
269 :
270 : END SUBROUTINE h5awrite_varlen_string
271 :
272 : ! **************************************************************************************************
273 : !> \brief Write a fixed-length string attribute
274 : !> \param loc_id either file id or group id
275 : !> \param attr_name the name of the attribute
276 : !> \param attr_data the attribute data, i.e. the string to write
277 : ! **************************************************************************************************
278 324 : SUBROUTINE h5awrite_fixlen_string(loc_id, attr_name, attr_data)
279 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
280 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
281 : CHARACTER(LEN=*), INTENT(IN), TARGET :: attr_data
282 :
283 : INTEGER :: error, output_unit
284 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
285 : TYPE(c_ptr) :: buffer
286 :
287 36 : output_unit = cp_logger_get_default_io_unit()
288 :
289 : ! create a scalar dataspace
290 36 : CALL h5screate_f(h5s_scalar_f, space_id, error)
291 36 : IF (error < 0) THEN
292 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
293 0 : ' ERROR: failed to create HDF5 dataspace'
294 0 : RETURN
295 : END IF
296 :
297 : ! create a fixed-length string datatype
298 36 : CALL h5tcopy_f(h5t_c_s1, type_id, error)
299 36 : CALL h5tset_cset_f(type_id, h5t_cset_utf8_f, error)
300 36 : CALL h5tset_size_f(type_id, LEN(attr_data, size_t), error)
301 :
302 : ! create the attribute
303 36 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
304 36 : IF (error < 0) THEN
305 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
306 0 : ' ERROR: failed to create HDF5 attribute'
307 0 : RETURN
308 : END IF
309 :
310 : ! the actual pointer to be passed
311 36 : buffer = C_LOC(attr_data)
312 :
313 : ! write the string attribute to file
314 36 : CALL h5awrite_f(attr_id, type_id, buffer, error)
315 36 : IF (error < 0) THEN
316 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
317 0 : ' ERROR: failed to write HDF5 attribute'
318 0 : RETURN
319 : END IF
320 :
321 : ! close attribute
322 36 : CALL h5aclose_f(attr_id, error)
323 36 : IF (error < 0) THEN
324 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
325 0 : ' ERROR: failed to close HDF5 attribute'
326 0 : RETURN
327 : END IF
328 :
329 : ! close dataspace
330 36 : CALL h5sclose_f(space_id, error)
331 36 : IF (error < 0) THEN
332 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
333 0 : ' ERROR: failed to close HDF5 dataspace'
334 0 : RETURN
335 : END IF
336 :
337 : ! close datatype
338 36 : CALL h5tclose_f(type_id, error)
339 36 : IF (error < 0) THEN
340 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
341 0 : ' ERROR: failed to close HDF5 datatype'
342 0 : RETURN
343 : END IF
344 :
345 : END SUBROUTINE h5awrite_fixlen_string
346 :
347 : ! **************************************************************************************************
348 : !> \brief Write a boolean attribute
349 : !> \param loc_id either file id or group id
350 : !> \param attr_name the name of the attribute
351 : !> \param attr_data the attribute data, i.e. the logical to write (.true. or .false.)
352 : ! **************************************************************************************************
353 28 : SUBROUTINE h5awrite_boolean(loc_id, attr_name, attr_data)
354 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
355 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
356 : LOGICAL, INTENT(IN) :: attr_data
357 :
358 : INTEGER :: error, output_unit
359 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
360 : INTEGER, TARGET :: attr_data_to_int
361 : TYPE(c_ptr) :: buffer
362 :
363 4 : output_unit = cp_logger_get_default_io_unit()
364 :
365 : ! 8-bit integers in enum bool_type
366 :
367 : ! create a scalar dataspace
368 4 : CALL h5screate_f(h5s_scalar_f, space_id, error)
369 4 : IF (error < 0) THEN
370 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
371 0 : ' ERROR: failed to create HDF5 dataspace'
372 0 : RETURN
373 : END IF
374 :
375 : ! create the datatype
376 4 : CALL h5tcreate_f(h5t_enum_f, INT(1, size_t), type_id, error)
377 4 : CALL h5tenum_insert_f(type_id, "FALSE", 0, error)
378 4 : CALL h5tenum_insert_f(type_id, "TRUE", 1, error)
379 :
380 4 : IF (attr_data) THEN
381 4 : attr_data_to_int = 1
382 : ELSE
383 0 : attr_data_to_int = 0
384 : END IF
385 : ! the C pointer to the actual data
386 4 : buffer = C_LOC(attr_data_to_int)
387 :
388 : ! create the attribute
389 4 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
390 4 : IF (error < 0) THEN
391 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
392 0 : ' ERROR: failed to create HDF5 attribute'
393 0 : RETURN
394 : END IF
395 :
396 : ! write the string attribute to file
397 4 : CALL h5awrite_f(attr_id, type_id, buffer, error)
398 4 : IF (error < 0) THEN
399 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
400 0 : ' ERROR: failed to write HDF5 attribute'
401 0 : RETURN
402 : END IF
403 :
404 : ! close attribute
405 4 : CALL h5aclose_f(attr_id, error)
406 4 : IF (error < 0) THEN
407 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
408 0 : ' ERROR: failed to close HDF5 attribute'
409 0 : RETURN
410 : END IF
411 :
412 : ! close dataspace
413 4 : CALL h5sclose_f(space_id, error)
414 4 : IF (error < 0) THEN
415 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
416 0 : ' ERROR: failed to close HDF5 dataspace'
417 0 : RETURN
418 : END IF
419 :
420 : ! close datatype
421 4 : CALL h5tclose_f(type_id, error)
422 4 : IF (error < 0) THEN
423 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
424 0 : ' ERROR: failed to close HDF5 datatype'
425 0 : RETURN
426 : END IF
427 :
428 : END SUBROUTINE h5awrite_boolean
429 :
430 : ! **************************************************************************************************
431 : !> \brief Write a (scalar) integer attribute
432 : !> \param loc_id either file id or group id
433 : !> \param attr_name the name of the attribute
434 : !> \param attr_data the attribute data, i.e. the integer to write
435 : ! **************************************************************************************************
436 240 : SUBROUTINE h5awrite_integer_scalar(loc_id, attr_name, attr_data)
437 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
438 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
439 : INTEGER, INTENT(IN), TARGET :: attr_data
440 :
441 : INTEGER :: error, output_unit
442 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
443 : TYPE(c_ptr) :: buffer
444 :
445 40 : output_unit = cp_logger_get_default_io_unit()
446 :
447 : ! create a scalar dataspace
448 40 : CALL h5screate_f(h5s_scalar_f, space_id, error)
449 40 : IF (error < 0) THEN
450 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
451 0 : ' ERROR: failed to create HDF5 dataspace'
452 0 : RETURN
453 : END IF
454 :
455 : ! the C pointer to the actual data
456 40 : buffer = C_LOC(attr_data)
457 :
458 : ! set the type of data
459 40 : type_id = h5t_native_integer
460 :
461 : ! create the attribute
462 40 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
463 40 : IF (error < 0) THEN
464 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
465 0 : ' ERROR: failed to create HDF5 attribute'
466 0 : RETURN
467 : END IF
468 :
469 : ! write the string attribute to file
470 40 : CALL h5awrite_f(attr_id, type_id, buffer, error)
471 40 : IF (error < 0) THEN
472 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
473 0 : ' ERROR: failed to write HDF5 attribute'
474 0 : RETURN
475 : END IF
476 :
477 : ! close attribute
478 40 : CALL h5aclose_f(attr_id, error)
479 40 : IF (error < 0) THEN
480 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
481 0 : ' ERROR: failed to close HDF5 attribute'
482 0 : RETURN
483 : END IF
484 :
485 : ! close dataspace
486 40 : CALL h5sclose_f(space_id, error)
487 40 : IF (error < 0) THEN
488 : WRITE (UNIT=output_unit, FMT="(/,T5,A,/)") &
489 0 : ' ERROR: failed to close HDF5 dataspace'
490 0 : RETURN
491 : END IF
492 :
493 : END SUBROUTINE h5awrite_integer_scalar
494 :
495 : ! **************************************************************************************************
496 : !> \brief Write a (scalar) double precision attribute
497 : !> \param loc_id either file id or group id
498 : !> \param attr_name the name of the attribute
499 : !> \param attr_data the attribute data, i.e. the double to write
500 : ! **************************************************************************************************
501 130 : SUBROUTINE h5awrite_double_scalar(loc_id, attr_name, attr_data)
502 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
503 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
504 : REAL(KIND=dp), INTENT(IN), TARGET :: attr_data
505 :
506 : INTEGER :: error
507 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
508 : TYPE(c_ptr) :: buffer
509 :
510 : ! create a scalar dataspace
511 26 : CALL h5screate_f(h5s_scalar_f, space_id, error)
512 26 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataspace')
513 :
514 : ! the C pointer to the actual data
515 26 : buffer = C_LOC(attr_data)
516 :
517 : ! set the type of data
518 26 : type_id = h5t_native_double
519 :
520 : ! create the attribute
521 26 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
522 26 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 attribute')
523 :
524 : ! write the string attribute to file
525 26 : CALL h5awrite_f(attr_id, type_id, buffer, error)
526 26 : IF (error < 0) CPABORT('ERROR: failed to write HDF5 attribute')
527 :
528 : ! close attribute
529 26 : CALL h5aclose_f(attr_id, error)
530 26 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 attribute')
531 :
532 : ! close dataspace
533 26 : CALL h5sclose_f(space_id, error)
534 26 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
535 :
536 26 : END SUBROUTINE h5awrite_double_scalar
537 :
538 : ! **************************************************************************************************
539 : !> \brief Write an array of fixed-length string attribute
540 : !> \param loc_id either file id or group id
541 : !> \param attr_name the name of the attribute
542 : !> \param attr_data the attribute data, i.e. the array of strings
543 : ! **************************************************************************************************
544 28 : SUBROUTINE h5awrite_string_simple(loc_id, attr_name, attr_data)
545 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
546 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
547 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN), TARGET :: attr_data
548 :
549 : INTEGER :: error
550 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
551 : INTEGER(KIND=hsize_t), DIMENSION(2) :: dims
552 : TYPE(c_ptr) :: buffer
553 :
554 4 : dims(1) = LEN(attr_data(1), kind=hsize_t) ! length of a string entry
555 4 : dims(2) = SIZE(attr_data, kind=hsize_t) ! length of array of strings
556 :
557 : ! create a fixed-length string datatype
558 4 : CALL h5tcopy_f(h5t_c_s1, type_id, error)
559 4 : CALL h5tset_cset_f(type_id, h5t_cset_utf8_f, error)
560 4 : CALL h5tset_size_f(type_id, INT(dims(1), size_t), error)
561 :
562 : ! create a simple dataspace
563 4 : CALL h5screate_simple_f(1, dims(2:2), space_id, error)
564 4 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataspace')
565 :
566 : ! create the atrtibute
567 4 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
568 4 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 attribute')
569 :
570 : ! the actual pointer to be passed
571 4 : buffer = C_LOC(attr_data(1))
572 :
573 : ! write the string array attribute to file
574 4 : CALL h5awrite_f(attr_id, type_id, buffer, error)
575 4 : IF (error < 0) CPABORT('ERROR: failed to write HDF5 attribute')
576 :
577 : ! close attribute
578 4 : CALL h5aclose_f(attr_id, error)
579 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 attribute')
580 :
581 : ! close dataspace
582 4 : CALL h5sclose_f(space_id, error)
583 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
584 :
585 : ! close datatype
586 4 : CALL h5tclose_f(type_id, error)
587 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 datatype')
588 :
589 4 : END SUBROUTINE h5awrite_string_simple
590 :
591 : ! **************************************************************************************************
592 : !> \brief Write an array of doubles attribute
593 : !> \param loc_id either file id or group id
594 : !> \param attr_name the name of the attribute
595 : !> \param attr_data the attribute data, i.e. the array of doubles
596 : ! **************************************************************************************************
597 40 : SUBROUTINE h5awrite_double_simple(loc_id, attr_name, attr_data)
598 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
599 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
600 : REAL(KIND=dp), DIMENSION(:), INTENT(IN), TARGET :: attr_data
601 :
602 : INTEGER :: error
603 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
604 : INTEGER(KIND=hsize_t), DIMENSION(1) :: dims
605 : TYPE(c_ptr) :: buffer
606 :
607 8 : dims(1) = SIZE(attr_data, kind=hsize_t) ! length of array of strings
608 :
609 : ! set the type of data
610 8 : type_id = h5t_native_double
611 :
612 : ! create a simple dataspace
613 8 : CALL h5screate_simple_f(1, dims, space_id, error)
614 8 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataspace')
615 :
616 : ! create the atrtibute
617 8 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
618 8 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 attribute')
619 :
620 : ! the actual pointer to be passed
621 8 : buffer = C_LOC(attr_data(1))
622 :
623 : ! write the string array attribute to file
624 8 : CALL h5awrite_f(attr_id, type_id, buffer, error)
625 8 : IF (error < 0) CPABORT('ERROR: failed to write HDF5 attribute')
626 :
627 : ! close attribute
628 8 : CALL h5aclose_f(attr_id, error)
629 8 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 attribute')
630 :
631 : ! close dataspace
632 8 : CALL h5sclose_f(space_id, error)
633 8 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
634 :
635 8 : END SUBROUTINE h5awrite_double_simple
636 :
637 : ! **************************************************************************************************
638 : !> \brief Write an array of integers attribute
639 : !> \param loc_id either file id or group id
640 : !> \param attr_name the name of the attribute
641 : !> \param attr_data the attribute data, i.e. the array of integers
642 : ! **************************************************************************************************
643 20 : SUBROUTINE h5awrite_integer_simple(loc_id, attr_name, attr_data)
644 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
645 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
646 : INTEGER, DIMENSION(:), INTENT(IN), TARGET :: attr_data
647 :
648 : INTEGER :: error
649 : INTEGER(KIND=hid_t) :: attr_id, space_id, type_id
650 : INTEGER(KIND=hsize_t), DIMENSION(1) :: dims
651 : TYPE(c_ptr) :: buffer
652 :
653 4 : dims(1) = SIZE(attr_data, kind=hsize_t) ! length of array of strings
654 :
655 : ! set the type of data
656 4 : type_id = h5t_native_integer
657 :
658 : ! create a simple dataspace
659 4 : CALL h5screate_simple_f(1, dims, space_id, error)
660 4 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataspace')
661 :
662 : ! create the atrtibute
663 4 : CALL h5acreate_f(loc_id, attr_name, type_id, space_id, attr_id, error)
664 4 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 attribute')
665 :
666 : ! the actual pointer to be passed
667 4 : buffer = C_LOC(attr_data(1))
668 :
669 : ! write the string array attribute to file
670 4 : CALL h5awrite_f(attr_id, type_id, buffer, error)
671 4 : IF (error < 0) CPABORT('ERROR: failed to write HDF5 attribute')
672 :
673 : ! close attribute
674 4 : CALL h5aclose_f(attr_id, error)
675 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 attribute')
676 :
677 : ! close dataspace
678 4 : CALL h5sclose_f(space_id, error)
679 4 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
680 :
681 4 : END SUBROUTINE h5awrite_integer_simple
682 :
683 : ! **************************************************************************************************
684 : !> \brief Write a dataset containing an array of doubles
685 : !> \param loc_id either file id or group id
686 : !> \param dset_name the name of the dataset
687 : !> \param dset_data the dataset data, i.e. the array of doubles
688 : ! **************************************************************************************************
689 120 : SUBROUTINE h5dwrite_double_simple(loc_id, dset_name, dset_data)
690 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
691 : CHARACTER(LEN=*), INTENT(IN) :: dset_name
692 : REAL(KIND=dp), DIMENSION(:), INTENT(IN), TARGET :: dset_data
693 :
694 : INTEGER :: error
695 : INTEGER(KIND=hid_t) :: dset_id, space_id, type_id
696 : INTEGER(KIND=hsize_t), DIMENSION(1) :: dims
697 : TYPE(c_ptr) :: buffer
698 :
699 24 : dims(1) = SIZE(dset_data, kind=hsize_t) ! length of array
700 :
701 : ! set the type of data
702 24 : type_id = h5t_native_double
703 :
704 : ! create a simple dataspace
705 24 : CALL h5screate_simple_f(1, dims, space_id, error)
706 24 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataspace')
707 :
708 : ! create the dataset
709 24 : CALL h5dcreate_f(loc_id, dset_name, type_id, space_id, dset_id, error)
710 24 : IF (error < 0) CPABORT('ERROR: failed to create HDF5 dataset')
711 :
712 : ! the actual pointer to be passed
713 24 : buffer = C_LOC(dset_data(1))
714 :
715 : ! write the string array attribute to file
716 24 : CALL h5dwrite_f(dset_id, type_id, buffer, error)
717 24 : IF (error < 0) CPABORT('ERROR: failed to write HDF5 dataset')
718 :
719 : ! close dataset
720 24 : CALL h5dclose_f(dset_id, error)
721 24 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataset')
722 :
723 : ! close dataspace
724 24 : CALL h5sclose_f(space_id, error)
725 24 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
726 :
727 24 : END SUBROUTINE h5dwrite_double_simple
728 :
729 : ! **************************************************************************************************
730 : !> \brief Read a dataset containing an array of doubles
731 : !> \param loc_id either file id or group id
732 : !> \param dset_name the name of the dataset
733 : !> \param dset_data where the read dataset data will be written
734 : ! **************************************************************************************************
735 0 : SUBROUTINE h5dread_double_simple(loc_id, dset_name, dset_data)
736 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
737 : CHARACTER(LEN=*), INTENT(IN) :: dset_name
738 : REAL(KIND=dp), DIMENSION(:), INTENT(OUT) :: dset_data
739 :
740 : INTEGER :: error
741 : INTEGER(KIND=hid_t) :: dset_id, npoints, space_id, type_id
742 : INTEGER(KIND=hsize_t), DIMENSION(1) :: dims
743 :
744 0 : dims(1) = SIZE(dset_data, kind=hsize_t) ! length of array
745 :
746 : ! set the type of data
747 0 : type_id = h5t_native_double
748 :
749 : ! open the dataset
750 0 : CALL h5dopen_f(loc_id, dset_name, dset_id, error)
751 0 : IF (error < 0) CPABORT('ERROR: failed to open HDF5 dataset')
752 :
753 : ! get information on the dataspace
754 0 : CALL h5dget_space_f(dset_id, space_id, error)
755 0 : IF (error < 0) CPABORT('ERROR: failed to fetch HDF5 dataspace info')
756 :
757 : ! get dataspace dims
758 0 : CALL h5sget_simple_extent_npoints_f(space_id, npoints, error)
759 0 : IF (error < 0) CPABORT('ERROR: failed to fetch HDF5 dataspace dimension')
760 :
761 : ! read the data
762 0 : CALL h5dread_f(dset_id, type_id, dset_data, dims, error)
763 0 : IF (error < 0) CPABORT('ERROR: failed to read HDF5 dataset')
764 :
765 : ! close dataset
766 0 : CALL h5dclose_f(dset_id, error)
767 0 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataset')
768 :
769 : ! close dataspace
770 0 : CALL h5sclose_f(space_id, error)
771 0 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 dataspace')
772 :
773 0 : END SUBROUTINE h5dread_double_simple
774 :
775 : ! **************************************************************************************************
776 : !> \brief Read an attribute containing a scalar double
777 : !> \param loc_id either file id or group id
778 : !> \param attr_name ...
779 : !> \param attr_data ...
780 : ! **************************************************************************************************
781 0 : SUBROUTINE h5aread_double_scalar(loc_id, attr_name, attr_data)
782 : INTEGER(KIND=hid_t), INTENT(IN) :: loc_id
783 : CHARACTER(LEN=*), INTENT(IN) :: attr_name
784 : REAL(KIND=dp), INTENT(OUT), TARGET :: attr_data
785 :
786 : INTEGER :: error
787 : INTEGER(KIND=hid_t) :: attr_id, type_id
788 : TYPE(c_ptr) :: buffer
789 :
790 : ! set the type of data
791 0 : type_id = h5t_native_double
792 :
793 : ! open the attribute
794 0 : CALL h5aopen_f(loc_id, attr_name, attr_id, error)
795 0 : IF (error < 0) CPABORT('ERROR: failed to open HDF5 attribute')
796 :
797 0 : buffer = C_LOC(attr_data)
798 : ! read the data
799 0 : CALL h5aread_f(attr_id, type_id, buffer, error)
800 0 : IF (error < 0) CPABORT('ERROR: failed to read HDF5 attribute')
801 :
802 : ! close the attribute
803 0 : CALL h5aclose_f(attr_id, error)
804 0 : IF (error < 0) CPABORT('ERROR: failed to close HDF5 attribute')
805 :
806 0 : END SUBROUTINE h5aread_double_scalar
807 :
808 : #endif
809 :
810 : END MODULE hdf5_wrapper
|