diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Ef.c | 148 | ||||
| -rw-r--r-- | fortran/src/H5Eff_F03.f90 | 154 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 57 | ||||
| -rw-r--r-- | fortran/test/tH5E_F03.f90 | 8 |
4 files changed, 64 insertions, 303 deletions
diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 875b59f..c0d7a77 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -319,151 +319,3 @@ nh5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *cl return ret_val; } - -int_f -H5Eget_auto3(void **client_data) -{ - int *i; - - i = (int*)client_data; - - *i = 1000; - printf(" Buffer In (C) = %d \n", *i); - - return 0; - -} - -int_f nprocess_buffer(hid_t_f *estack_id, void **buffer) -{ - int status; - int *i; - H5E_auto2_t func_c; - - status = H5Eget_auto2((hid_t)*estack_id, &func_c, buffer); -/* status = H5Eget_auto3(buffer); */ - - i = (int*)buffer; - - printf(" Buffer In (C) = %d \n", *i); - return; -} -/****if* H5Ef/h5eget_auto_c - * NAME - * h5eget_auto_c - * PURPOSE - * Calls H5Eget_auto2 - * INPUTS - * estack_id - Error stack identifier - * OUTPUTS - * func - The function currently set to be called upon an error condition. - * client_data - Data currently set to be passed to the error function. - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * M. Scot Breitenfeld - * July 10, 2009 - * NOTE - * if func is the default H5Eprint or H5Eprint2 then need to use the Fortran callback function - * associated with H5Eprint*. - * SOURCE -*/ -int_f -nh5eget_auto_c(hid_t_f *estack_id, H5E_auto2_t *func, void **client_data, int_f *ret_func) -/******/ -{ - int ret_val = -1; - herr_t status = -1; - hid_t dataset; - H5E_auto2_t func_c; - void *client_data_c=NULL; - void **data_c; - int *i; - -/* status = H5Eget_auto3(client_data); */ -/* i = (int*)client_data; */ - -/* printf(" Buffer In (C3) = %d \n", *i); */ - -/* return 0; */ - -/* *ret_func = -1; */ - - status = H5Eget_auto2((hid_t)*estack_id, &func_c, &client_data_c); - -/* status = H5Eget_auto2((hid_t)*estack_id, &func_c, client_data); */ - - i = (int*)*client_data; - -/* *i = 1000; */ - - -/* i = (int*)client_data_c; */ -/* *i = 100; */ - -/* *client_data = client_data_c; */ -/* *data_c = client_data_c; */ - - printf("aa %d \n",*((int*)client_data_c)); -/* printf("bb %d \n",**((int**)client_data)); */ -/* printf("cc %d \n",**((int**)data_c)); */ - -/* printf("a %p \n",client_data_c); */ -/* printf("b %p \n",*client_data); */ -/* printf("c %p \n",*data_c); */ - -/* i = (int*)client_data_c; */ -/* **client_data = *((int*)client_data_c);*/ - -/* *i = 200; */ - -/* if(client_data == NULL) */ -/* printf("error \n"); */ - -/* if(func == NULL) */ -/* printf("error \n"); */ - -/* #ifdef H5_USE_16_API */ -/* if (func == (H5E_auto_t)H5Eprint) */ -/* *ret_func = 0; */ -/* #else /\* H5_USE_16_API *\/ */ -/* if (func == (H5E_auto2_t)H5Eprint2) */ -/* *ret_func = 0; */ -/* #endif /\* H5_USE_16_API *\/ */ - -/* #ifdef H5_USE_16_API */ -/* if (func == (H5E_auto_t)H5Eprint) */ -/* *ret_func = 0; */ -/* #else /\* H5_USE_16_API *\/ */ -/* if (func == (H5E_auto2_t)H5Eprint2) */ -/* *ret_func = 0; */ /* printf("%p %p \n",func,(H5E_auto2_t)H5Eprint2); */ -/* #endif /\* H5_USE_16_API *\/ */ - -/* printf(" ret %d \n", ret_val); */ - if (status >= 0) ret_val = 0; - ret_func = 0; - return ret_val; -} - -void* -nh5eget_auto_c2(hid_t_f *estack_id, H5E_auto2_t *func, int_f *ret_func) -/******/ -{ - int ret_val = -1; - herr_t status = -1; - hid_t dataset; - H5E_auto2_t func_c; - void *client_data_c=NULL; - void **data_c; - int *i; - - status = H5Eget_auto2((hid_t)*estack_id, &func_c, &client_data_c); - - printf("a %p \n",client_data_c); - - - if (status >= 0) ret_val = 0; - ret_func = 0; - return client_data_c; -} - diff --git a/fortran/src/H5Eff_F03.f90 b/fortran/src/H5Eff_F03.f90 index bf4797f..164f203 100644 --- a/fortran/src/H5Eff_F03.f90 +++ b/fortran/src/H5Eff_F03.f90 @@ -1,7 +1,7 @@ !****h* ROBODoc/H5E (F03) ! ! NAME -! H5L_PROVISIONAL +! H5E_PROVISIONAL ! ! FILE ! src/fortran/src/H5Eff_F03.f90 @@ -9,9 +9,9 @@ ! PURPOSE ! ! This file contains Fortran 90 and Fortran 2003 interfaces for H5E functions. -! It contains the same functions as H5Eff_DEPRECIATE.f90 but includes the +! It contains the same functions as H5Eff_F90.f90 but includes the ! Fortran 2003 functions and the interface listings. This file will be compiled -! instead of H5Eff_DEPRECIATE.f90 if Fortran 2003 functions are enabled. +! instead of H5Eff_F90.f90 if Fortran 2003 functions are enabled. ! ! ! COPYRIGHT @@ -44,24 +44,10 @@ MODULE H5E_PROVISIONAL CONTAINS - INTEGER FUNCTION h5eprint_def() bind(C) - - USE ISO_C_BINDING - IMPLICIT NONE - INTEGER :: hdferr - - PRINT*,'Inside h5eprint_def' -! STOP - -!!$ CALL h5eprint_f(hdferr) -!!$ h5eprint_def = hdferr - - END FUNCTION h5eprint_def - -!****s* H5E/h5eset_auto2_f +!****s* H5E/h5eset_auto_f ! ! NAME -! h5eset_auto2_f +! h5eset_auto_f ! ! PURPOSE ! Returns settings for automatic error stack traversal function and its data. @@ -82,9 +68,9 @@ CONTAINS ! M. Scot Breitenfeld ! July 10, 2009 ! -! Signature: +! Fortran2003 Interface: SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data) - USE ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING INTEGER , INTENT(IN) :: printflag INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id @@ -96,7 +82,7 @@ CONTAINS TYPE(C_PTR) :: client_data_default INTERFACE INTEGER FUNCTION h5eset_auto2_c(printflag, estack_id, func, client_data) - USE ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING USE H5GLOBAL !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5ESET_AUTO2_C'::h5eset_auto2_c @@ -121,128 +107,4 @@ CONTAINS hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default) END SUBROUTINE h5eset_auto_f -!****s* H5E/h5eget_auto_f -! -! NAME -! h5eget_auto_f -! -! PURPOSE -! Returns the settings for the automatic error stack traversal function and its data. -! -! Inputs: -! estack_id - Error stack identifier. H5E_DEFAULT_F indicates the current stack. -! Outputs: -! func - The function currently set to be called upon an error condition. -! client_data - Data currently set to be passed to the error function. -! hdferr - Returns 0 if successful and -1 if fails. -! -! AUTHOR -! M. Scot Breitenfeld -! July 10, 2009 -! -! Signature: - SUBROUTINE h5eget_auto_f(estack_id, op, client_data, hdferr) - USE ISO_C_BINDING - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: estack_id -!!$ TYPE(C_FUNPTR) :: op_f -!!$ TYPE(C_PTR) :: client_data_f - TYPE(C_FUNPTR) :: op - TYPE(C_PTR), VALUE :: client_data - INTEGER, INTENT(OUT) :: hdferr -!***** - INTEGER :: ret_func2 - !INTEGER(C_INT), DIMENSION(:), POINTER :: ptr_data - INTEGER, DIMENSION(1:1) :: array_shape - TYPE(C_PTR), TARGET :: f_ptr1 - INTEGER(C_INT) :: ptr_data - INTEGER(C_INT) :: i - TYPE(C_PTR) :: test - INTEGER, POINTER :: a - - INTEGER, TARGET :: j - TYPE(C_PTR) :: f_ptr2 - - INTERFACE - INTEGER FUNCTION h5eget_auto_c(estack_id, op, client_data, ret_func2) - USE ISO_C_BINDING - USE H5GLOBAL - IMPLICIT NONE - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c - !DEC$ENDIF - INTEGER(HID_T) :: estack_id - TYPE(C_FUNPTR) :: op - TYPE(C_PTR) :: client_data - INTEGER :: ret_func2 - END FUNCTION h5eget_auto_c - -!!$ TYPE(C_PTR) FUNCTION h5eget_auto_c2(estack_id, op, ret_func2) -!!$ USE ISO_C_BINDING -!!$ USE H5GLOBAL -!!$ IMPLICIT NONE -!!$ !DEC$IF DEFINED(HDF5F90_WINDOWS) -!!$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c -!!$ !DEC$ENDIF -!!$ INTEGER(HID_T) :: estack_id -!!$ TYPE(C_FUNPTR) :: op -!!$ INTEGER :: ret_func2 -!!$ END FUNCTION h5eget_auto_c2 - -!!$ SUBROUTINE process_buffer(estack_id, buffer) -!!$ USE, INTRINSIC :: ISO_C_BINDING -!!$ USE H5GLOBAL -!!$ INTEGER(HID_T) :: estack_id -!!$ TYPE(C_PTR) :: buffer -!!$ END SUBROUTINE process_buffer - - END INTERFACE - -! j = -9999 - - - f_ptr2 = c_loc(j) -! CALL process_buffer(estack_id,f_ptr2) - - hdferr = h5eget_auto_c(estack_id, op, f_ptr2, ret_func2) - -!!!!! PRINT*,c_associated(f_ptr2) -!!$ hdferr = h5eget_auto_c(estack_id, op, client_data, ret_func2) - - PRINT*,'fortran',j - stop - -! client_data = h5eget_auto_c2(estack_id, op, ret_func2) - -! PRINT*,'Is client_data associated',C_associated(client_data) -! PRINT*,'Is op_data associated',C_associated(op) - -! ALLOCATE(i(1:1)) -! CALL c_f_pointer(f_ptr2,a,[1]) -! CALL c_f_pointer(f_ptr2,i) -! PRINT*,i -! PRINT*,"Buffer in (F) = ", a(1) - -! stop - -! ALLOCATE(ptr_data(1:2)) -! ptr_data = 0 -! array_shape(1) = 1 -! CALL C_F_POINTER(client_data, ptr_data, array_shape) -! CALL C_F_POINTER(f_ptr2, i,(/ 1 /)) - -! ptr_data => f_ptr1(1) - -! PRINT*,'value in fortran',i - - -! Check to see if the user created their own function, -! otherwise we have to create a fortran version of the default - -!!$ IF(ret_func2.EQ.0)THEN -!!$ op = c_funloc(h5eprint_def) -!!$ END IF - - END SUBROUTINE h5eget_auto_f - END MODULE H5E_PROVISIONAL diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 7f45ff9..89957a4 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -27,6 +27,57 @@ H5_FCDLL void HD5packFstring(char *src, char *dest, size_t len); #endif /*H5_VMS*/ /* + * Storage info struct used by H5O_info_t and H5F_info_t + * interoperable with Fortran. + */ +typedef struct H5_ih_info_t_f { + hsize_t index_size; /* btree and/or list */ + hsize_t heap_size; +} H5_ih_info_t_f; + +/* Information struct for object header metadata (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) + * interoperable with Fortran. + */ +typedef struct H5O_hdr_info_t_f { + int_f version; /* Version number of header format in file */ + int_f nmesgs; /* Number of object header messages */ + int_f nchunks; /* Number of object header chunks */ + int_f flags; /* Object header status flags */ + struct { + hsize_t total; /* Total space for storing object header in file */ + hsize_t meta; /* Space within header for object header metadata information */ + hsize_t mesg; /* Space within header for actual message information */ + hsize_t free; /* Free space within object header */ + } space; + struct { + uint64_t present; /* Flags to indicate presence of message type in header */ + uint64_t shared; /* Flags to indicate message type is shared in header */ + } mesg; +} H5O_hdr_info_t_f; + +/* Information struct for object (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx) + * interoperable with Fortran. + */ +typedef struct H5O_info_t_f { + unsigned long fileno; /* File number that object is located in */ + haddr_t_f addr; /* Object address in file */ + int_f type; /* Basic object type (group, dataset, etc.) */ + int_f rc; /* Reference count of object */ + int_f atime[8]; /* Access time */ + int_f mtime[8]; /* Modification time */ + int_f ctime[8]; /* Change time */ + int_f btime[8]; /* Birth time */ + hsize_t num_attrs; /* # of attributes attached to object */ + H5O_hdr_info_t_f hdr; /* Object header information */ + /* Extra metadata storage for obj & attributes */ + struct { + H5_ih_info_t_f obj; /* v1/v2 B-tree & local/fractal heap for groups, B-tree for chunked datasets */ + H5_ih_info_t_f attr; /* v2 B-tree & heap for attributes */ + } meta_size; +} H5O_info_t_f; + + +/* * Functions from H5Ff.c */ #define nh5fcreate_c H5_FC_FUNC_(h5fcreate_c, H5FCREATE_C) @@ -766,7 +817,7 @@ H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, s hid_t_f *lcpl_id, hid_t_f *lapl_id); H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data); H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id, - H5O_info_t *object_info); + H5O_info_t_f *object_info); /* * Functions from H5Pf.c */ @@ -1144,8 +1195,6 @@ H5_FCDLL int_f nh5iis_valid_c(hid_t_f *obj_id, int_f *c_valid); #define nh5eget_minor_c H5_FC_FUNC_(h5eget_minor_c, H5EGET_MINOR_C) #define nh5eset_auto_c H5_FC_FUNC_(h5eset_auto_c, H5ESET_AUTO_C) #define nh5eset_auto2_c H5_FC_FUNC_(h5eset_auto2_c, H5ESET_AUTO2_C) -#define nh5eget_auto_c H5_FC_FUNC_(h5eget_auto_c, H5EGET_AUTO_C) -#define nh5eget_auto_c2 H5_FC_FUNC_(h5eget_auto_c2, H5EGET_AUTO_C2) #define nprocess_buffer H5_FC_FUNC_(process_buffer, PROCESS_BUFFER) @@ -1156,8 +1205,6 @@ H5_FCDLL int_f nh5eget_major_c(int_f* error_no, _fcd name, size_t_f* namelen); H5_FCDLL int_f nh5eget_minor_c(int_f* error_no, _fcd name, size_t_f* namelen); H5_FCDLL int_f nh5eset_auto_c(int_f* printflag); H5_FCDLL int_f nh5eset_auto2_c(int_f* printflag, hid_t_f *estack_id, H5E_auto2_t func, void *client_data); -H5_FCDLL int_f nh5eget_auto_c(hid_t_f *estack_id, H5E_auto2_t *func, void **client_data, int_f* ret_func); -H5_FCDLL void* nh5eget_auto_c2(hid_t_f *estack_id, H5E_auto2_t *func, int_f* ret_func); H5_FCDLL int_f nprocess_buffer(hid_t_f *estack_id,void **buffer); /* diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90 index 75a534e..04e3190 100644 --- a/fortran/test/tH5E_F03.f90 +++ b/fortran/test/tH5E_F03.f90 @@ -158,10 +158,10 @@ SUBROUTINE test_error(total_error) !!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error) !!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error) - ! Test enabling and disabling default printing - - CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error) - CALL VERIFY("H5Eget_auto_f", error, 0, total_error) +!!$ ! Test enabling and disabling default printing +!!$ +!!$ CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error) +!!$ CALL VERIFY("H5Eget_auto_f", error, 0, total_error) ! PRINT*,c_associated(f_ptr1) |