1!****h* ROBODoc/H5E 2! 3! NAME 4! MODULE H5E 5! 6! FILE 7! fortran/src/H5Eff.F90 8! 9! PURPOSE 10! This Module contains Fortran interfaces for H5E functions. 11! 12! COPYRIGHT 13! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14! Copyright by The HDF Group. * 15! Copyright by the Board of Trustees of the University of Illinois. * 16! All rights reserved. * 17! * 18! This file is part of HDF5. The full HDF5 copyright notice, including * 19! terms governing use, modification, and redistribution, is contained in * 20! the COPYING file, which can be found at the root of the source code * 21! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * 22! If you do not have access to either file, you may request a copy from * 23! help@hdfgroup.org. * 24! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25! 26! NOTES 27! _____ __ __ _____ ____ _____ _______ _ _ _______ 28! |_ _| \/ | __ \ / __ \| __ \__ __|/\ | \ | |__ __| 29! **** | | | \ / | |__) | | | | |__) | | | / \ | \| | | | **** 30! **** | | | |\/| | ___/| | | | _ / | | / /\ \ | . ` | | | **** 31! **** _| |_| | | | | | |__| | | \ \ | |/ ____ \| |\ | | | **** 32! |_____|_| |_|_| \____/|_| \_\ |_/_/ \_\_| \_| |_| 33! 34! If you add a new H5E function to the module you must add the function name 35! to the Windows dll file 'hdf5_fortrandll.def.in' in the fortran/src directory. 36! This is needed for Windows based operating systems. 37! 38!***** 39 40MODULE H5E 41 42 USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_FUNPTR, C_CHAR 43 USE H5GLOBAL 44 45 !Turn on automatic printing of errors 46 INTEGER, PARAMETER :: PRINTON = 1 47 48 !Turn off automatic printing of errors 49 INTEGER, PARAMETER :: PRINTOFF = 0 50 51CONTAINS 52 53!****s* H5E/h5eclear_f 54! 55! NAME 56! h5eclear_f 57! 58! PURPOSE 59! Clears the error stack for the current thread. 60! 61! OUTPUTS 62! hdferr - Returns 0 if successful and -1 if fails 63! OPTIONAL PARAMETERS 64! estack_id - Error Stack id 65! AUTHOR 66! Elena Pourmal 67! August 12, 1999 68! 69! HISTORY 70! Explicit Fortran interfaces were added for 71! called C functions (it is needed for Windows 72! port). April 6, 2001 73! 74! Added optional error stack identifier in order to bring 75! the function in line with the h5eclear2 routine. 76! MSB, July 9, 2009 77! 78! SOURCE 79 SUBROUTINE h5eclear_f(hdferr, estack_id) 80 IMPLICIT NONE 81 INTEGER, INTENT(OUT) :: hdferr ! Error code 82 INTEGER(HID_T), OPTIONAL, INTENT(IN) :: estack_id 83!***** 84 INTEGER(HID_T) :: estack_id_default 85 86 INTERFACE 87 INTEGER FUNCTION h5eclear_c(estack_id_default) BIND(C,NAME='h5eclear_c') 88 IMPORT :: HID_T 89 IMPLICIT NONE 90 INTEGER(HID_T) :: estack_id_default 91 END FUNCTION h5eclear_c 92 END INTERFACE 93 94 estack_id_default = H5E_DEFAULT_F 95 IF(PRESENT(estack_id)) estack_id_default = estack_id 96 97 hdferr = h5eclear_c(estack_id_default) 98 END SUBROUTINE h5eclear_f 99 100!****s* H5E/h5eprint_f 101! 102! NAME 103! h5eprint_f 104! 105! PURPOSE 106! Prints the error stack in a default manner. 107! 108! OUTPUTS 109! hdferr - Returns 0 if successful and -1 if fails 110! 111! OPTIONAL PARAMETERS 112! name - name of the file that contains print output 113! AUTHOR 114! Elena Pourmal 115! August 12, 1999 116! 117! HISTORY 118! Explicit Fortran interfaces were added for 119! called C functions (it is needed for Windows 120! port). April 6, 2001 121! 122! SOURCE 123 SUBROUTINE h5eprint_f(hdferr, name) 124 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: name 125 INTEGER, INTENT(OUT) :: hdferr 126!***** 127 INTEGER :: namelen 128 129 INTERFACE 130 INTEGER FUNCTION h5eprint_c1(name, namelen) BIND(C,NAME='h5eprint_c1') 131 IMPORT :: C_CHAR 132 IMPLICIT NONE 133 INTEGER :: namelen 134 CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name 135 END FUNCTION h5eprint_c1 136 END INTERFACE 137 138 INTERFACE 139 INTEGER FUNCTION h5eprint_c2() BIND(C,NAME='h5eprint_c2') 140 END FUNCTION h5eprint_c2 141 END INTERFACE 142 143 IF (PRESENT(name)) THEN 144 namelen = LEN(NAME) 145 hdferr = h5eprint_c1(name, namelen) 146 ELSE 147 hdferr = h5eprint_c2() 148 ENDIF 149 END SUBROUTINE h5eprint_f 150!****s* H5E/h5eget_major_f 151! 152! NAME 153! h5eget_major_f 154! 155! PURPOSE 156! Returns a character string describing an error specified 157! by a major error number. 158! 159! INPUTS 160! error_no - major error number 161! 162! OUTPUTS 163! name - character string describing the error 164! namelen - number of characters in the name buffer 165! hdferr - Returns 0 if successful and -1 if fails 166! 167! AUTHOR 168! Elena Pourmal 169! August 12, 1999 170! 171! HISTORY 172! Explicit Fortran interfaces were added for 173! called C functions (it is needed for Windows 174! port). April 6, 2001 175! 176! SOURCE 177 SUBROUTINE h5eget_major_f(error_no, name, namelen, hdferr) 178 INTEGER, INTENT(IN) :: error_no ! Major error number 179 CHARACTER(LEN=*), INTENT(OUT) :: name ! Character string describing 180 ! the error. 181 INTEGER(SIZE_T), INTENT(IN) :: namelen ! Anticipated number of characters 182 ! in name. 183 INTEGER, INTENT(OUT) :: hdferr ! Error code 184!***** 185 INTERFACE 186 INTEGER FUNCTION h5eget_major_c(error_no, name, namelen) BIND(C,NAME='h5eget_major_c') 187 IMPORT :: C_CHAR 188 IMPORT :: SIZE_T 189 IMPLICIT NONE 190 INTEGER :: error_no 191 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name 192 INTEGER(SIZE_T), INTENT(IN) :: namelen 193 END FUNCTION h5eget_major_c 194 END INTERFACE 195 196 hdferr = h5eget_major_c(error_no, name, namelen) 197 END SUBROUTINE h5eget_major_f 198!****s* H5E/h5eget_minor_f 199! 200! NAME 201! h5eget_minor_f 202! 203! PURPOSE 204! Returns a character string describing an error specified 205! by a minor error number. 206! 207! INPUTS 208! error_no - minor error number 209! 210! OUTPUTS 211! name - character string describing the error 212! hdferr - Returns 0 if successful and -1 if fails 213! 214! AUTHOR 215! Elena Pourmal 216! August 12, 1999 217! 218! HISTORY 219! Explicit Fortran interfaces were added for 220! called C functions (it is needed for Windows 221! port). April 6, 2001 222! 223! SOURCE 224 SUBROUTINE h5eget_minor_f(error_no, name, hdferr) 225 INTEGER, INTENT(IN) :: error_no ! Major error number 226 CHARACTER(LEN=*), INTENT(OUT) :: name ! Character string describing 227 ! the error 228 INTEGER, INTENT(OUT) :: hdferr ! Error code 229!***** 230 INTERFACE 231 INTEGER FUNCTION h5eget_minor_c(error_no, name) BIND(C,NAME='h5eget_minor_c') 232 IMPORT :: C_CHAR 233 INTEGER :: error_no 234 CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(OUT) :: name 235 END FUNCTION h5eget_minor_c 236 END INTERFACE 237 238 hdferr = h5eget_minor_c(error_no, name) 239 END SUBROUTINE h5eget_minor_f 240 241!****s* H5E/h5eset_auto_f 242! 243! NAME 244! h5eset_auto_f 245! 246! PURPOSE 247! Returns settings for automatic error stack traversal function and its data. 248! 249! Inputs: 250! printflag - Flag to turn automatic error printing on or off; 251! possible values are: 252! printon (1) 253! printoff(0) 254! estack_id - Error stack identifier. 255! func - Function to be called upon an error condition. 256! client_data - Data passed to the error function 257! 258! Outputs: 259! hdferr - Returns 0 if successful and -1 if fails 260! 261! AUTHOR 262! M. Scot Breitenfeld 263! July 10, 2009 264! 265! Fortran2003 Interface: 266 SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data) 267 USE, INTRINSIC :: ISO_C_BINDING 268 INTEGER , INTENT(IN) :: printflag 269 INTEGER , INTENT(OUT) :: hdferr 270 INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id 271 TYPE(C_FUNPTR), INTENT(IN) , OPTIONAL :: func 272 TYPE(C_PTR) , INTENT(IN) , OPTIONAL :: client_data 273!***** 274 INTEGER(HID_T) :: estack_id_default 275 TYPE(C_FUNPTR) :: func_default 276 TYPE(C_PTR) :: client_data_default 277 INTERFACE 278 INTEGER FUNCTION h5eset_auto2_c(printflag, estack_id, func, client_data) & 279 BIND(C, NAME='h5eset_auto2_c') 280 IMPORT :: c_ptr, c_funptr 281 IMPORT :: HID_T 282 INTEGER :: printflag 283 INTEGER(HID_T) :: estack_id 284 TYPE(C_FUNPTR), VALUE :: func 285 TYPE(C_PTR), VALUE :: client_data 286 END FUNCTION h5eset_auto2_c 287 END INTERFACE 288 289 estack_id_default = -1 290 func_default = C_NULL_FUNPTR 291 client_data_default = C_NULL_PTR 292 293 IF(PRESENT(estack_id)) estack_id_default = estack_id 294 IF(PRESENT(func)) func_default = func 295 IF(PRESENT(client_data)) client_data_default = client_data 296 297 hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default) 298 END SUBROUTINE h5eset_auto_f 299 300END MODULE H5E 301 302