!> @defgroup FH5E Fortran Error (H5E) Interface
!!
!! @see H5E, C-API
!!
!! @see @ref H5E_UG, User Guide
!!
!> @ingroup FH5E
!!
!! @brief This module contains Fortran interfaces for H5E functions.
!
! COPYRIGHT
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! Copyright by The HDF Group. *
! All rights reserved. *
! *
! This file is part of HDF5. The full HDF5 copyright notice, including *
! terms governing use, modification, and redistribution, is contained in *
! the COPYING file, which can be found at the root of the source code *
! distribution tree, or in https://www.hdfgroup.org/licenses. *
! If you do not have access to either file, you may request a copy from *
! help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! NOTES
! _____ __ __ _____ ____ _____ _______ _ _ _______
! |_ _| \/ | __ \ / __ \| __ \__ __|/\ | \ | |__ __|
! **** | | | \ / | |__) | | | | |__) | | | / \ | \| | | | ****
! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | ****
! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | ****
! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_|
!
! If you add a new H5E function to the module you must add the function name
! to the Windows dll file 'hdf5_fortrandll.def.in' in the fortran/src directory.
! This is needed for Windows based operating systems.
!
! MISSING: H5Eauto_is_v2, H5Eget_auto2
MODULE H5E
USE H5GLOBAL
USE H5fortkit
IMPLICIT NONE
INTEGER, PARAMETER :: PRINTON = 1 !< Turn on automatic printing of errors
INTEGER, PARAMETER :: PRINTOFF = 0 !< Turn off automatic printing of errors
!> @brief h5e_error_t derived type
TYPE, BIND(C) :: h5e_error_t
INTEGER(HID_T) :: cls_id !< Class ID
INTEGER(HID_T) :: maj_num !< Major error ID
INTEGER(HID_T) :: min_num !< Minor error number
INTEGER(C_INT) :: line !< Line in file where error occurs
TYPE(C_PTR) :: func_name !< Function in which error occurred
TYPE(C_PTR) :: file_name !< File in which error occurred
TYPE(C_PTR) :: desc !< Optional supplied description
END TYPE h5e_error_t
INTERFACE h5eprint_f
MODULE PROCEDURE h5eprint1_f
MODULE PROCEDURE h5eprint2_f
END INTERFACE h5eprint_f
INTERFACE
INTEGER FUNCTION h5eprint_c(err_stack, name, namelen) BIND(C,NAME='h5eprint_c')
IMPORT :: C_CHAR, HID_T, C_PTR
IMPLICIT NONE
INTEGER(HID_T) :: err_stack
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name
TYPE(C_PTR), VALUE :: namelen
END FUNCTION h5eprint_c
END INTERFACE
CONTAINS
!>
!! \ingroup FH5E
!!
!! \brief Clears the error stack for the current thread.
!!
!! \param hdferr \fortran_error
!! \param estack_id Error Stack id
!!
!! See C API: @ref H5Eclear2()
!!
SUBROUTINE h5eclear_f(hdferr, estack_id)
IMPLICIT NONE
INTEGER, INTENT(OUT) :: hdferr
INTEGER(HID_T), INTENT(IN), OPTIONAL :: estack_id
INTEGER(HID_T) :: estack_id_default
INTERFACE
INTEGER(C_INT) FUNCTION H5Eclear(err_stack) BIND(C,NAME='H5Eclear2')
IMPORT :: C_INT, HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack
END FUNCTION H5Eclear
END INTERFACE
estack_id_default = H5E_DEFAULT_F
IF(PRESENT(estack_id)) estack_id_default = estack_id
hdferr = INT(H5Eclear(estack_id_default))
END SUBROUTINE h5eclear_f
#ifdef H5_DOXYGEN
!>
!! \ingroup FH5E
!!
!! \brief Prints the error stack in a default manner.
!!
!! \param hdferr \fortran_error
!! \param name Name of the file that contains print output
!!
!! \note If \p name is not specified, the output will be sent to
!! the standard error (stderr).
!!
!! \attention Deprecated.
!!
!! See C API: @ref H5Eprint1()
!!
SUBROUTINE h5eprint_f(hdferr, name)
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
INTEGER, INTENT(OUT) :: hdferr
END SUBROUTINE h5eprint_f
!! \ingroup FH5E
!!
!! \brief Prints the error stack in a default manner.
!!
!! \param err_stack Error stack identifier
!! \param hdferr \fortran_error
!! \param name Name of the file that contains print output
!!
!! \note If \p name is not specified, the output will be sent to
!! the standard error (stderr).
!!
!! See C API: @ref H5Eprint2()
!!
SUBROUTINE h5eprint_f(err_stack, hdferr, name)
INTEGER(HID_T) , INTENT(IN) :: err_stack
INTEGER , INTENT(OUT) :: hdferr
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
END SUBROUTINE h5eprint_f
#else
SUBROUTINE h5eprint1_f(hdferr, name)
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
INTEGER, INTENT(OUT) :: hdferr
CALL h5eprint2_f(H5E_DEFAULT_F, hdferr, name)
END SUBROUTINE h5eprint1_f
SUBROUTINE h5eprint2_f(err_stack, hdferr, name)
INTEGER(HID_T), INTENT(IN) :: err_stack
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
INTEGER, INTENT(OUT) :: hdferr
INTEGER(SIZE_T), TARGET :: namelen
TYPE(C_PTR) :: c_namelen
IF (PRESENT(name)) THEN
namelen = LEN(NAME, SIZE_T)
c_namelen = C_LOC(namelen)
hdferr = h5eprint_c(err_stack, name, c_namelen)
ELSE
hdferr = h5eprint_c(err_stack, C_NULL_CHAR, C_NULL_PTR)
ENDIF
END SUBROUTINE h5eprint2_f
#endif
!>
!! \ingroup FH5E
!!
!! \brief Returns a character string describing an error specified by a major error number.
!!
!! \param error_no Major error number.
!! \param name Character string describing the error.
!! \param namelen Number of characters in the name buffer.
!! \param hdferr \fortran_error
!!
!! \attention Deprecated: use H5Eget_msg_f() instead.
!!
!! See C API: @ref H5Eget_major()
!!
SUBROUTINE h5eget_major_f(error_no, name, namelen, hdferr)
INTEGER(HID_T) , INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER(SIZE_T) , INTENT(INOUT) :: namelen
INTEGER, INTENT(OUT) :: hdferr
INTEGER :: msg_type
INTEGER(SIZE_T) :: namelen2
namelen2 = namelen
CALL H5Eget_msg_f(error_no, msg_type, name, hdferr, namelen2)
END SUBROUTINE h5eget_major_f
!>
!! \ingroup FH5E
!!
!! \brief Returns a character string describing an error specified by a minor error number.
!!
!! \param error_no Minor error number.
!! \param name Character string describing the error.
!! \param hdferr \fortran_error
!!
!! \attention Deprecated: use H5Eget_msg_f() instead.
!!
!! See C API: @ref H5Eget_minor()
!!
SUBROUTINE h5eget_minor_f(error_no, name, hdferr)
INTEGER(HID_T) , INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER, INTENT(OUT) :: hdferr
INTEGER :: msg_type
CALL H5Eget_msg_f(error_no, msg_type, name, hdferr)
END SUBROUTINE h5eget_minor_f
!>
!! \ingroup FH5E
!!
!! \brief Returns settings for automatic error stack traversal function and its data.
!!
!! \param printflag Flag to turn automatic error printing on or off; possible values are:
!! \li printon (1)
!! \li printoff(0)
!! \param estack_id Error stack identifier.
!! \param func Function to be called upon an error condition.
!! \param client_data Data passed to the error function.
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eset_auto2()
!!
SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR
INTEGER , INTENT(IN) :: printflag
INTEGER , INTENT(OUT) :: hdferr
INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id
TYPE(C_FUNPTR), INTENT(IN) , OPTIONAL :: func
TYPE(C_PTR) , INTENT(IN) , OPTIONAL :: client_data
INTEGER(HID_T) :: estack_id_default
TYPE(C_FUNPTR) :: func_default
TYPE(C_PTR) :: client_data_default
INTERFACE
INTEGER FUNCTION h5eset_auto2_c(printflag, estack_id, func, client_data) &
BIND(C, NAME='h5eset_auto2_c')
IMPORT :: c_ptr, c_funptr
IMPORT :: HID_T
INTEGER :: printflag
INTEGER(HID_T) :: estack_id
TYPE(C_FUNPTR), VALUE :: func
TYPE(C_PTR), VALUE :: client_data
END FUNCTION h5eset_auto2_c
END INTERFACE
estack_id_default = -1
func_default = C_NULL_FUNPTR
client_data_default = C_NULL_PTR
IF(PRESENT(estack_id)) estack_id_default = estack_id
IF(PRESENT(func)) func_default = func
IF(PRESENT(client_data)) client_data_default = client_data
hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default)
END SUBROUTINE h5eset_auto_f
!>
!! \ingroup FH5E
!!
!! \brief Pushes a new error record onto an error stack.
!!
!! \param err_stack Error stack identifier. If the identifier is H5E_DEFAULT_F, the error
!! record will be pushed to the current stack.
!! \param cls_id Error class identifier
!! \param maj_id Major error identifier
!! \param min_id Minor error identifier
!! \param msg Error description string
!! \param hdferr \fortran_error
!! \param file Name of the file in which the error was detected
!! \param func Name of the function in which the error was detected
!! \param line Line number in the file where the error was detected
!! \param arg1 C style format control strings
!! \param arg2 C style format control strings
!! \param arg3 C style format control strings
!! \param arg4 C style format control strings
!! \param arg5 C style format control strings
!! \param arg6 C style format control strings
!! \param arg7 C style format control strings
!! \param arg8 C style format control strings
!! \param arg9 C style format control strings
!! \param arg10 C style format control strings
!! \param arg11 C style format control strings
!! \param arg12 C style format control strings
!! \param arg13 C style format control strings
!! \param arg14 C style format control strings
!! \param arg15 C style format control strings
!! \param arg16 C style format control strings
!! \param arg17 C style format control strings
!! \param arg18 C style format control strings
!! \param arg19 C style format control strings
!! \param arg20 C style format control strings
!!
!! \note \p arg[1-20] expects C-style format strings, similar to the
!! system and C functions printf() and fprintf().
!! Furthermore, special characters, such as ANSI escapes,
!! will only be interpreted correctly if the Fortran equivalent
!! is used. For example, to print \p msg "TEXT" in red and has
!! a space after the text would be:
!!
!! \code
!! (..., "%s TEXT %s"//C_NEW_LINE, hdferr, ..., arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" )
!! \endcode
!!
Using "\n" instead of C_NEW_LINE will not be interpereted correctly, and similarly,
!! using "\x1B" instead of ACHAR(27)
!!
!!
!! See C API: @ref H5Epush2()
!!
SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, &
file, func, line, &
arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, &
arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: err_stack
INTEGER(HID_T), INTENT(IN) :: cls_id
INTEGER(HID_T), INTENT(IN) :: maj_id
INTEGER(HID_T), INTENT(IN) :: min_id
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER, INTENT(OUT) :: hdferr
TYPE(C_PTR), OPTIONAL :: file
TYPE(C_PTR), OPTIONAL :: func
TYPE(C_PTR), OPTIONAL :: line
CHARACTER(LEN=*), OPTIONAL, TARGET :: arg1, arg2, arg3, arg4, arg5, &
arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, &
arg16, arg17, arg18, arg19, arg20
TYPE(C_PTR) :: file_def = C_NULL_PTR
TYPE(C_PTR) :: func_def = C_NULL_PTR
TYPE(C_PTR) :: line_def = C_NULL_PTR
TYPE(C_PTR) :: arg1_def = C_NULL_PTR, arg2_def = C_NULL_PTR, &
arg3_def = C_NULL_PTR, arg4_def = C_NULL_PTR, &
arg5_def = C_NULL_PTR, arg6_def = C_NULL_PTR, &
arg7_def = C_NULL_PTR, arg8_def = C_NULL_PTR, &
arg9_def = C_NULL_PTR, arg10_def = C_NULL_PTR, &
arg11_def = C_NULL_PTR, arg12_def = C_NULL_PTR, &
arg13_def = C_NULL_PTR, arg14_def = C_NULL_PTR, &
arg15_def = C_NULL_PTR, arg16_def = C_NULL_PTR, &
arg17_def = C_NULL_PTR, arg18_def = C_NULL_PTR, &
arg19_def = C_NULL_PTR, arg20_def = C_NULL_PTR
INTERFACE
INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, msg_len, file, func, line, &
arg1, arg2, arg3, arg4, arg5, &
arg6, arg7, arg8, arg9, arg10, &
arg11, arg12, arg13, arg14, arg15, &
arg16, arg17, arg18, arg19, arg20) BIND(C, NAME='h5epush_c')
IMPORT :: C_CHAR, C_INT, C_PTR
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T) :: err_stack
INTEGER(HID_T) :: cls_id
INTEGER(HID_T) :: maj_id
INTEGER(HID_T) :: min_id
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: msg
INTEGER :: msg_len
TYPE(C_PTR), VALUE :: file
TYPE(C_PTR), VALUE :: func
TYPE(C_PTR), VALUE :: line
TYPE(C_PTR), VALUE :: arg1, arg2, arg3, arg4, &
arg5, arg6, arg7, arg8, &
arg9, arg10, arg11, arg12, &
arg13, arg14, arg15, arg16, &
arg17, arg18, arg19, arg20
END FUNCTION h5epush_c
END INTERFACE
IF (PRESENT(file)) file_def = file
IF (PRESENT(func)) func_def = func
IF (PRESENT(line)) line_def = line
IF (PRESENT(arg1)) arg1_def = C_LOC(arg1(1:1))
IF (PRESENT(arg2)) arg2_def = C_LOC(arg2(1:1))
IF (PRESENT(arg3)) arg3_def = C_LOC(arg3(1:1))
IF (PRESENT(arg4)) arg4_def = C_LOC(arg4(1:1))
IF (PRESENT(arg5)) arg5_def = C_LOC(arg5(1:1))
IF (PRESENT(arg6)) arg6_def = C_LOC(arg6(1:1))
IF (PRESENT(arg7)) arg7_def = C_LOC(arg7(1:1))
IF (PRESENT(arg8)) arg8_def = C_LOC(arg8(1:1))
IF (PRESENT(arg9)) arg9_def = C_LOC(arg9(1:1))
IF (PRESENT(arg10)) arg10_def = C_LOC(arg10(1:1))
IF (PRESENT(arg11)) arg11_def = C_LOC(arg11(1:1))
IF (PRESENT(arg12)) arg12_def = C_LOC(arg12(1:1))
IF (PRESENT(arg13)) arg13_def = C_LOC(arg13(1:1))
IF (PRESENT(arg14)) arg14_def = C_LOC(arg14(1:1))
IF (PRESENT(arg15)) arg15_def = C_LOC(arg15(1:1))
IF (PRESENT(arg16)) arg16_def = C_LOC(arg16(1:1))
IF (PRESENT(arg17)) arg17_def = C_LOC(arg17(1:1))
IF (PRESENT(arg18)) arg18_def = C_LOC(arg18(1:1))
IF (PRESENT(arg19)) arg19_def = C_LOC(arg19(1:1))
IF (PRESENT(arg20)) arg20_def = C_LOC(arg20(1:1))
hdferr = h5epush_c(err_stack, cls_id, maj_id, min_id, msg, LEN(msg), &
file_def, func_def, line_def, &
arg1_def, arg2_def, arg3_def, arg4_def, arg5_def, &
arg6_def, arg7_def, arg8_def, arg9_def, arg10_def, &
arg11_def, arg12_def, arg13_def, arg14_def, arg15_def, &
arg16_def, arg17_def, arg18_def, arg19_def, arg20_def)
END SUBROUTINE h5epush_f
!>
!! \ingroup FH5E
!!
!! \brief Registers a client library or application program to the HDF5 error API.
!!
!! \param cls_name Name of the error class
!! \param lib_name Name of the client library or application to which the error class belongs
!! \param version Version of the client library or application to which the error class belongs. It can be NULL.
!! \param class_id Class identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eregister_class()
!!
SUBROUTINE h5eregister_class_f(cls_name, lib_name, version, class_id, hdferr)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: cls_name
CHARACTER(LEN=*), INTENT(IN) :: lib_name
CHARACTER(LEN=*), INTENT(IN) :: version
INTEGER(HID_T) , INTENT(OUT) :: class_id
INTEGER, INTENT(OUT) :: hdferr
CHARACTER(LEN=LEN_TRIM(cls_name)+1,KIND=C_CHAR) :: c_cls_name
CHARACTER(LEN=LEN_TRIM(lib_name)+1,KIND=C_CHAR) :: c_lib_name
CHARACTER(LEN=LEN_TRIM(version)+1,KIND=C_CHAR) :: c_version
INTERFACE
INTEGER(HID_T) FUNCTION H5Eregister_class(cls_name, lib_name, version) &
BIND(C,NAME='H5Eregister_class')
IMPORT :: C_CHAR
IMPORT :: HID_T
IMPLICIT NONE
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: cls_name
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: lib_name
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: version
END FUNCTION H5Eregister_class
END INTERFACE
c_cls_name = TRIM(cls_name)//C_NULL_CHAR
c_lib_name = TRIM(lib_name)//C_NULL_CHAR
c_version = TRIM(version)//C_NULL_CHAR
class_id = H5Eregister_class(c_cls_name, c_lib_name, c_version)
hdferr = 0
IF(class_id.LT.0) hdferr = -1
END SUBROUTINE h5eregister_class_f
!>
!! \ingroup FH5E
!!
!! \brief Removes an error class.
!!
!! \param class_id Class identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eunregister_class()
!!
SUBROUTINE h5eunregister_class_f(class_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: class_id
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Eunregister_class(class_id) BIND(C, NAME='H5Eunregister_class')
IMPORT :: HID_T, C_INT
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN), VALUE :: class_id
END FUNCTION H5Eunregister_class
END INTERFACE
hdferr = INT(H5Eunregister_class(class_id))
END SUBROUTINE h5eunregister_class_f
!>
!! \ingroup FH5E
!!
!! \brief Adds a major or minor error message to an error class.
!!
!! \param class_id An error class identifier
!! \param msg_type The type of the error message
!! \param msg Error message
!! \param err_id Error identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Ecreate_msg()
!!
SUBROUTINE h5ecreate_msg_f(class_id, msg_type, msg, err_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: class_id
INTEGER , INTENT(IN) :: msg_type
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER(HID_T) , INTENT(OUT) :: err_id
INTEGER, INTENT(OUT) :: hdferr
CHARACTER(LEN=LEN_TRIM(msg)+1,KIND=C_CHAR) :: c_msg
INTERFACE
INTEGER(HID_T) FUNCTION H5Ecreate_msg(class_id, msg_type, msg) &
BIND(C,NAME='H5Ecreate_msg')
IMPORT :: C_CHAR, C_INT
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: class_id
INTEGER(C_INT), VALUE :: msg_type
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: msg
END FUNCTION H5Ecreate_msg
END INTERFACE
c_msg = TRIM(msg)//C_NULL_CHAR
err_id = H5Ecreate_msg(class_id, INT(msg_type, C_INT), c_msg)
hdferr = 0
IF(err_id.LT.0) hdferr = -1
END SUBROUTINE h5ecreate_msg_f
!>
!! \ingroup FH5E
!!
!! \brief Closes an error message.
!!
!! \param err_id An error message identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eclose_msg()
!!
SUBROUTINE h5eclose_msg_f(err_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: err_id
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Eclose_msg(err_id) BIND(C, NAME='H5Eclose_msg')
IMPORT :: HID_T, C_INT
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_id
END FUNCTION H5Eclose_msg
END INTERFACE
hdferr = INT(H5Eclose_msg(err_id))
END SUBROUTINE h5eclose_msg_f
!>
!! \ingroup FH5E
!!
!! \brief Retrieves an error message.
!!
!! \param msg_id Error message identifier
!! \param msg_type The type of the error message. Valid values are H5E_MAJOR_F and H5E_MINOR_F.
!! \param msg Error message buffer
!! \param hdferr \fortran_error
!! \param msg_size The length of error message to be returned by this function
!!
!! If \p msg_size is omitted, the API will copy up to the length of \p msg, and it
!! is the application's responsibility to provide a large enough buffer. If \p msg_size
!! is zero, the required buffer size will be returned, and \p msg is not accessed.
!! If \p msg_size is greater than zero, the function will copy up to the length
!! of \p msg_size info \p msg.
!!
!! See C API: @ref H5Eget_msg()
!!
SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, hdferr, msg_size)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: msg_id
INTEGER , INTENT(OUT) :: msg_type
CHARACTER(LEN=*) :: msg
INTEGER , INTENT(OUT) :: hdferr
INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: msg_size
CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), ALLOCATABLE, TARGET :: c_msg
INTEGER(C_INT) :: c_msg_type
TYPE(C_PTR) :: f_ptr
INTEGER(SIZE_T) :: msg_cp_sz
INTEGER(SIZE_T) :: c_msg_size
INTERFACE
INTEGER(SIZE_T) FUNCTION H5Eget_msg(msg_id, msg_type, msg, size) &
BIND(C,NAME='H5Eget_msg')
IMPORT :: C_CHAR, C_PTR, C_INT
IMPORT :: HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: msg_id
INTEGER(C_INT) :: msg_type
TYPE(C_PTR) , VALUE :: msg
INTEGER(SIZE_T), VALUE :: size
END FUNCTION H5Eget_msg
END INTERFACE
hdferr = 0
msg_cp_sz = 0
IF(PRESENT(msg_size))THEN
IF(msg_size .EQ. 0)THEN
c_msg_size = H5Eget_msg(msg_id, c_msg_type, C_NULL_PTR, 0_SIZE_T)
IF(PRESENT(msg_size)) msg_size = c_msg_size
msg_type = INT(c_msg_type)
IF(c_msg_size.LT.0) hdferr = -1
RETURN
ELSE
msg_cp_sz = msg_size
ENDIF
ENDIF
IF(msg_cp_sz.EQ.0) msg_cp_sz = LEN(msg)
ALLOCATE(c_msg(1:msg_cp_sz+1), stat=hdferr)
IF (hdferr .NE. 0) THEN
hdferr = -1
RETURN
ENDIF
f_ptr = C_LOC(c_msg(1)(1:1))
c_msg_size = H5Eget_msg(msg_id, c_msg_type, f_ptr, msg_cp_sz+1)
CALL HD5c2fstring(msg, c_msg, msg_cp_sz, msg_cp_sz+1_SIZE_T)
DEALLOCATE(c_msg)
IF(PRESENT(msg_size))THEN
msg_size = c_msg_size
ENDIF
msg_type = INT(c_msg_type)
IF(c_msg_size.LT.0) hdferr = -1
END SUBROUTINE H5Eget_msg_f
!>
!! \ingroup FH5E
!!
!! \brief Retrieves the number of error messages in an error stack.
!!
!! \param error_stack_id An error message identifier
!! \param count Number of error messages in \p err_id
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_num()
!!
SUBROUTINE h5eget_num_f(error_stack_id, count, hdferr)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: error_stack_id
INTEGER(SIZE_T), INTENT(OUT) :: count
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(SIZE_T) FUNCTION H5Eget_num(error_stack_id) BIND(C, NAME='H5Eget_num')
IMPORT :: HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: error_stack_id
END FUNCTION H5Eget_num
END INTERFACE
count = H5Eget_num(error_stack_id)
hdferr = 0
IF(count.LT.0) hdferr = -1
END SUBROUTINE h5eget_num_f
!>
!! \ingroup FH5E
!!
!! \brief Walks the specified error stack, calling the specified function.
!!
!! \param err_stack Error stack identifier
!! \param direction Direction in which the error stack is to be walked
!! \param op Function to be called for each error encountered
!! \param op_data Data to be passed to func
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Ewalk2()
!!
SUBROUTINE h5ewalk_f(err_stack, direction, op, op_data, hdferr)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: err_stack
INTEGER , INTENT(IN) :: direction
TYPE(C_FUNPTR) , INTENT(IN) :: op
TYPE(C_PTR) , INTENT(INOUT) :: op_data ! Declare INOUT to bypass gfortran 4.8.5 issue
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Ewalk(err_stack, direction, op, op_data) &
BIND(C, NAME='H5Ewalk2')
IMPORT :: HID_T, C_FUNPTR, C_PTR, C_INT
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack
INTEGER(C_INT), VALUE :: direction
TYPE(C_FUNPTR), VALUE :: op
TYPE(C_PTR) , VALUE :: op_data
END FUNCTION H5Ewalk
END INTERFACE
hdferr = INT(H5Ewalk(err_stack, INT(direction, C_INT), op, op_data))
END SUBROUTINE h5ewalk_f
!>
!! \ingroup FH5E
!!
!! \brief Retrieves an error message.
!!
!! \param class_id Error class identifier
!! \param name Buffer for the error class name
!! \param hdferr \fortran_error
!! \param size The maximum number of characters of the class name to be returned by this function in \p name.
!!
!! If \p size is omitted, the API will copy up to the length of \p name, and it
!! is the application's responsibility to provide a large enough buffer. If \p size
!! is zero, the required buffer size will be returned, and \p name is not accessed.
!! If \p size is greater than zero, the function will copy up to the length
!! of \p size info \p name.
!!
!! See C API: @ref H5Eget_class_name()
!!
SUBROUTINE H5Eget_class_name_f(class_id, name, hdferr, size)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN) :: class_id
CHARACTER(LEN=*) :: name
INTEGER , INTENT(OUT) :: hdferr
INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: size
CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), ALLOCATABLE, TARGET :: c_name
TYPE(C_PTR) :: f_ptr
INTEGER(SIZE_T) :: name_cp_sz
INTEGER(SIZE_T) :: c_size
INTERFACE
INTEGER(SIZE_T) FUNCTION H5Eget_class_name(class_id, name, size) &
BIND(C,NAME='H5Eget_class_name')
IMPORT :: C_PTR, C_CHAR
IMPORT :: HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T) , VALUE :: class_id
TYPE(C_PTR) , VALUE :: name
INTEGER(SIZE_T), VALUE :: size
END FUNCTION H5Eget_class_name
END INTERFACE
hdferr = 0
name_cp_sz = 0
IF(PRESENT(size))THEN
IF(size .EQ. 0)THEN
c_size = H5Eget_class_name(class_id, C_NULL_PTR, 0_SIZE_T)
IF(PRESENT(size)) size = c_size
IF(c_size.LT.0) hdferr = -1
RETURN
ELSE
name_cp_sz = size
ENDIF
ENDIF
IF(name_cp_sz.EQ.0) name_cp_sz = LEN(name)
ALLOCATE(c_name(1:name_cp_sz+1), stat=hdferr)
IF (hdferr .NE. 0) THEN
hdferr = -1
RETURN
ENDIF
f_ptr = C_LOC(c_name)
c_size = H5Eget_class_name(class_id, f_ptr, name_cp_sz+1_SIZE_T)
CALL HD5c2fstring(name, c_name, name_cp_sz, name_cp_sz+1_SIZE_T)
DEALLOCATE(c_name)
IF(PRESENT(size))THEN
size = c_size
ENDIF
IF(c_size.LT.0) hdferr = -1
END SUBROUTINE H5Eget_class_name_f
!>
!! \ingroup FH5E
!!
!! \brief Appends one error stack to another, optionally closing the source stack.
!!
!! \param dst_stack_id Error stack identifier
!! \param src_stack_id Error stack identifier
!! \param close_source_stack Flag to indicate whether to close the source stack
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eappend_stack()
!!
SUBROUTINE H5Eappend_stack_f(dst_stack_id, src_stack_id, close_source_stack, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dst_stack_id
INTEGER(HID_T), INTENT(IN) :: src_stack_id
LOGICAL , INTENT(IN) :: close_source_stack
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Eappend_stack(dst_stack_id, src_stack_id, close_source_stack) &
BIND(C, NAME='H5Eappend_stack')
IMPORT :: HID_T, C_BOOL, C_INT
IMPLICIT NONE
INTEGER(HID_T) , VALUE :: dst_stack_id
INTEGER(HID_T) , VALUE :: src_stack_id
LOGICAL(C_BOOL), VALUE :: close_source_stack
END FUNCTION H5Eappend_stack
END INTERFACE
hdferr = INT(H5Eappend_stack(dst_stack_id, src_stack_id, LOGICAL(close_source_stack, C_BOOL)))
END SUBROUTINE H5Eappend_stack_f
!>
!! \ingroup FH5E
!!
!! \brief Returns a copy of the current error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_current_stack()
!!
SUBROUTINE H5Eget_current_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(OUT) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(HID_T) FUNCTION H5Eget_current_stack() BIND(C, NAME='H5Eget_current_stack')
IMPORT :: HID_T
IMPLICIT NONE
END FUNCTION H5Eget_current_stack
END INTERFACE
err_stack_id = H5Eget_current_stack()
hdferr = 0
IF(err_stack_id.LT.0) hdferr = -1
END SUBROUTINE H5Eget_current_stack_f
!>
!! \ingroup FH5E
!!
!! \brief Replaces the current error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eset_current_stack()
!!
SUBROUTINE H5Eset_current_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN ) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Eset_current_stack(err_stack_id) BIND(C, NAME='H5Eset_current_stack')
IMPORT :: C_INT, HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack_id
END FUNCTION H5Eset_current_stack
END INTERFACE
hdferr = INT(H5Eset_current_stack(err_stack_id))
END SUBROUTINE H5Eset_current_stack_f
!>
!! \ingroup FH5E
!!
!! \brief Closes an error stack handle.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eclose_stack()
!!
SUBROUTINE H5Eclose_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN ) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Eclose_stack(err_stack_id) BIND(C, NAME='H5Eclose_stack')
IMPORT :: C_INT, HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack_id
END FUNCTION H5Eclose_stack
END INTERFACE
hdferr = INT(H5Eclose_stack(err_stack_id))
END SUBROUTINE H5Eclose_stack_f
!>
!! \ingroup FH5E
!!
!! \brief Creates a new, empty error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Ecreate_stack()
!!
SUBROUTINE H5Ecreate_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(OUT) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(HID_T) FUNCTION H5Ecreate_stack() BIND(C, NAME='H5Ecreate_stack')
IMPORT :: HID_T
IMPLICIT NONE
END FUNCTION H5Ecreate_stack
END INTERFACE
err_stack_id = H5Ecreate_stack()
hdferr = 0
IF(err_stack_id.LT.0) hdferr = -1
END SUBROUTINE H5Ecreate_stack_f
!>
!! \ingroup FH5E
!!
!! \brief Deletes specified number of error messages from the error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param count The number of error messages to be deleted from the top of error stack
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Epop()
!!
SUBROUTINE H5Epop_f(err_stack_id, count, hdferr)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN ) :: err_stack_id
INTEGER(SIZE_T), INTENT(IN ) :: count
INTEGER , INTENT(OUT) :: hdferr
INTERFACE
INTEGER(C_INT) FUNCTION H5Epop(err_stack_id, count) BIND(C, NAME='H5Epop')
IMPORT :: C_INT, HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T) , VALUE :: err_stack_id
INTEGER(SIZE_T), VALUE :: count
END FUNCTION H5Epop
END INTERFACE
hdferr = INT(H5Epop(err_stack_id, count))
END SUBROUTINE H5Epop_f
END MODULE H5E