diff options
Diffstat (limited to 'fortran/src')
-rw-r--r-- | fortran/src/CMakeLists.txt | 6 | ||||
-rw-r--r-- | fortran/src/H5Aff.F90 | 3 | ||||
-rw-r--r-- | fortran/src/H5Dff.F90 | 9 | ||||
-rw-r--r-- | fortran/src/H5Fff.F90 | 93 | ||||
-rw-r--r-- | fortran/src/H5Of.c | 48 | ||||
-rw-r--r-- | fortran/src/H5Off.F90 | 107 | ||||
-rw-r--r-- | fortran/src/H5Pff.F90 | 99 | ||||
-rw-r--r-- | fortran/src/H5Rff.F90 | 6 | ||||
-rw-r--r-- | fortran/src/H5Tff.F90 | 2 | ||||
-rw-r--r-- | fortran/src/H5_buildiface.F90 | 194 | ||||
-rw-r--r-- | fortran/src/H5_f.c | 11 | ||||
-rw-r--r-- | fortran/src/H5_ff.F90 | 74 | ||||
-rw-r--r-- | fortran/src/H5config_f.inc.cmake | 2 | ||||
-rw-r--r-- | fortran/src/H5f90global.F90 | 13 | ||||
-rw-r--r-- | fortran/src/H5f90proto.h | 10 | ||||
-rw-r--r-- | fortran/src/H5match_types.c | 13 | ||||
-rw-r--r-- | fortran/src/Makefile.in | 30 | ||||
-rw-r--r-- | fortran/src/hdf5_fortrandll.def.in | 5 |
18 files changed, 612 insertions, 113 deletions
diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index 025fab5..f71e820 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -9,11 +9,7 @@ if (WIN32) if (NOT H5_HAVE_PARALLEL) set (H5_NOPAREXP ";") endif () - if (NOT HDF5_ENABLE_F2003) - set (H5_NOF03EXP ";") - else () - set (H5_F03EXP ";") - endif () + set (H5_F03EXP ";") configure_file (${HDF5_F90_SRC_SOURCE_DIR}/hdf5_fortrandll.def.in ${HDF5_F90_SRC_BINARY_DIR}/hdf5_fortrandll.def @ONLY) endif () endif () diff --git a/fortran/src/H5Aff.F90 b/fortran/src/H5Aff.F90 index 827b803..a728f2d 100644 --- a/fortran/src/H5Aff.F90 +++ b/fortran/src/H5Aff.F90 @@ -76,6 +76,9 @@ MODULE H5A USE H5GLOBAL + PRIVATE h5awrite_char_scalar, h5awrite_ptr + PRIVATE h5aread_char_scalar, h5aread_ptr + INTERFACE h5awrite_f MODULE PROCEDURE h5awrite_char_scalar ! This is the preferred way to call h5awrite diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 3915f72..77f0a15 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -90,6 +90,15 @@ MODULE H5D USE, INTRINSIC :: ISO_C_BINDING USE H5GLOBAL + PRIVATE h5dread_vl_integer, h5dread_vl_real, h5dread_vl_string + PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string + PRIVATE h5dwrite_reference_obj, h5dwrite_reference_dsetreg, h5dwrite_char_scalar, h5dwrite_ptr + PRIVATE h5dread_reference_obj, h5dread_reference_dsetreg, h5dread_char_scalar, h5dread_ptr + PRIVATE h5dfill_integer, h5dfill_c_float, h5dfill_c_double, h5dfill_char +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + PRIVATE h5dfill_c_long_double +#endif + INTERFACE h5dextend_f MODULE PROCEDURE h5dset_extent_f END INTERFACE diff --git a/fortran/src/H5Fff.F90 b/fortran/src/H5Fff.F90 index 358e421..bf797b2 100644 --- a/fortran/src/H5Fff.F90 +++ b/fortran/src/H5Fff.F90 @@ -874,4 +874,97 @@ CONTAINS END SUBROUTINE h5fget_file_image_f +!****s* H5F (F03)/h5fget_dset_no_attrs_hint_f_F03 +! +! NAME +! h5fget_dset_no_attrs_hint_f +! +! PURPOSE +! Gets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! file_id - Target file identifier. +! +! OUTPUTS +! minimize - Value of the setting. +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5fget_dset_no_attrs_hint_f(file_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: file_id + LOGICAL , INTENT(OUT) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5fget_dset_no_attrs_hint_c(file_id, minimize) BIND(C, NAME='H5Fget_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: file_id + LOGICAL(C_BOOL), INTENT(OUT) :: minimize + END FUNCTION h5fget_dset_no_attrs_hint_c + END INTERFACE + + hdferr = INT(h5fget_dset_no_attrs_hint_c(file_id, c_minimize)) + + ! Transfer value of C C_BOOL type to Fortran LOGICAL + minimize = c_minimize + + END SUBROUTINE h5fget_dset_no_attrs_hint_f + +!****s* H5F (F03)/h5fset_dset_no_attrs_hint_f_F03 +! +! NAME +! h5fset_dset_no_attrs_hint_f +! +! PURPOSE +! Sets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! file_id - Target file identifier. +! minimize - Value of the setting. +! +! OUTPUTS +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5fset_dset_no_attrs_hint_f(file_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: file_id + LOGICAL , INTENT(IN) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5fset_dset_no_attrs_hint_c(file_id, minimize) BIND(C, NAME='H5Fset_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: file_id + LOGICAL(C_BOOL), INTENT(IN), VALUE :: minimize + END FUNCTION h5fset_dset_no_attrs_hint_c + END INTERFACE + + ! Transfer value of Fortran LOGICAL to C C_BOOL type + c_minimize = minimize + + hdferr = INT(h5fset_dset_no_attrs_hint_c(file_id, c_minimize)) + + END SUBROUTINE h5fset_dset_no_attrs_hint_f + END MODULE H5F + diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c index 45b7f09..08305ea 100644 --- a/fortran/src/H5Of.c +++ b/fortran/src/H5Of.c @@ -27,11 +27,15 @@ fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info); int_f fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { + /* This function does not used the field parameter because we want + * this function to fill the unfilled fields with C's default values. + */ + struct tm *ts; object_info->fileno = Oinfo.fileno; object_info->addr = (haddr_t_f)Oinfo.addr; - + object_info->type = (int_f)Oinfo.type; object_info->rc = (int_f)Oinfo.rc; @@ -96,6 +100,8 @@ fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) { object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size; object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size; + object_info->meta_size.attr.index_size = (hsize_t_f)Oinfo.meta_size.attr.index_size; + object_info->meta_size.attr.heap_size = (hsize_t_f)Oinfo.meta_size.attr.heap_size; return 0; @@ -138,7 +144,7 @@ h5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen * Call H5Olink function. */ if((hid_t_f)H5Olink((hid_t)*object_id, (hid_t)*new_loc_id, c_name, - (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); done: @@ -229,6 +235,7 @@ h5oclose_c ( hid_t_f *object_id ) * idx - Iteration position at which to start * op - Callback function passing data regarding the link to the calling application * op_data - User-defined pointer to data required by the application for its processing of the link + * fields - Flags specifying the fields to include in object_info. * * OUTPUTS * idx - Position at which an interrupted iteration may be restarted @@ -241,7 +248,7 @@ h5oclose_c ( hid_t_f *object_id ) * SOURCE */ int_f -h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data ) +h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data, int_f *fields ) /******/ { int_f ret_value = -1; /* Return value */ @@ -250,7 +257,8 @@ h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, /* * Call H5Ovisit2 */ - func_ret_value = H5Ovisit2( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, op_data, H5O_INFO_ALL); + + func_ret_value = H5Ovisit2( (hid_t)*group_id, (H5_index_t)*index_type, (H5_iter_order_t)*order, op, op_data, (unsigned)*fields); ret_value = (int_f)func_ret_value; @@ -302,6 +310,7 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) * name - Name of group, relative to loc_id. * namelen - Name length. * lapl_id - Link access property list. + * fields - Flags specifying the fields to include in object_info. * OUTPUTS * object_info - Buffer in which to return object information. * @@ -314,7 +323,7 @@ h5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id) */ int_f h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info) + H5O_info_t_f *object_info, int_f *fields) /******/ { char *c_name = NULL; /* Buffer to hold C string */ @@ -331,10 +340,10 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l * Call H5Oinfo_by_name function. */ if(H5Oget_info_by_name2((hid_t)*loc_id, c_name, - &Oinfo, H5O_INFO_ALL, (hid_t)*lapl_id) < 0) + &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); - ret_value = fill_h5o_info_t_f(Oinfo,object_info); + ret_value = fill_h5o_info_t_f(Oinfo, object_info); done: if(c_name) @@ -354,6 +363,7 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l * lapl_id - Link access property list. * OUTPUTS * object_info - Buffer in which to return object information. + * fields - Flags specifying the fields to include in object_info. * * RETURNS * 0 on success, -1 on failure @@ -364,7 +374,7 @@ h5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *l */ int_f h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, - int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info) + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields) /******/ { char *c_group_name = NULL; /* Buffer to hold C string */ @@ -386,7 +396,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, * Call H5Oinfo_by_idx function. */ if(H5Oget_info_by_idx2((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, - &Oinfo, H5O_INFO_ALL, (hid_t)*lapl_id) < 0) + &Oinfo, (unsigned)*fields, (hid_t)*lapl_id) < 0) HGOTO_DONE(FAIL); ret_value = fill_h5o_info_t_f(Oinfo,object_info); @@ -404,6 +414,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, * Calls H5Oget_info * INPUTS * object_id - Identifier for target object. + * fields - Flags specifying the fields to include in object_info. * OUTPUTS * object_info - Buffer in which to return object information. * @@ -415,7 +426,7 @@ h5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, * SOURCE */ int_f -h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) +h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields) /******/ { int_f ret_value = 0; /* Return value */ @@ -424,7 +435,7 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) /* * Call H5Oinfo_by_name function. */ - if(H5Oget_info2((hid_t)*object_id, &Oinfo, H5O_INFO_ALL) < 0) + if(H5Oget_info2((hid_t)*object_id, &Oinfo, (unsigned)*fields) < 0) HGOTO_DONE(FAIL); ret_value = fill_h5o_info_t_f(Oinfo,object_info); @@ -457,8 +468,8 @@ h5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info) */ int_f h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, - hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, - hid_t_f *ocpypl_id, hid_t_f *lcpl_id ) + hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, + hid_t_f *ocpypl_id, hid_t_f *lcpl_id ) /******/ { char *c_src_name = NULL; /* Buffer to hold C string */ @@ -478,7 +489,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, * Call H5Ocopy function. */ if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name, - (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0) + (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0) HGOTO_DONE(FAIL); done: @@ -503,6 +514,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, * idx - Iteration position at which to start * op - Callback function passing data regarding the link to the calling application * op_data - User-defined pointer to data required by the application for its processing of the link + * fields - Flags specifying the fields to include in object_info. * * OUTPUTS * idx - Position at which an interrupted iteration may be restarted @@ -516,7 +528,7 @@ h5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, */ int_f h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, - H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ) + H5O_iterate_t op, void *op_data, hid_t_f *lapl_id, int_f *fields ) /******/ { int_f ret_value = -1; /* Return value */ @@ -533,7 +545,7 @@ h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f * Call H5Ovisit */ func_ret_value = H5Ovisit_by_name2( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order, - op, op_data, H5O_INFO_ALL, (hid_t)*lapl_id); + op, op_data, (unsigned)*fields, (hid_t)*lapl_id); ret_value = (int_f)func_ret_value; done: @@ -763,7 +775,7 @@ h5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fc */ int_f h5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, - int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) + int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id) /******/ { char *c_group_name = NULL; /* Buffer to hold C string */ @@ -868,7 +880,7 @@ h5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssi */ int_f h5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size, - _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id) + _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id) /******/ { char *c_comment = NULL; /* Buffer to hold C string */ diff --git a/fortran/src/H5Off.F90 b/fortran/src/H5Off.F90 index 243ec29..8c77230 100644 --- a/fortran/src/H5Off.F90 +++ b/fortran/src/H5Off.F90 @@ -69,6 +69,15 @@ MODULE H5O TYPE(mesg_t) :: mesg END TYPE hdr_t + TYPE, BIND(C) :: c_hdr_t + INTEGER(C_INT) :: version ! Version number of header format in file + INTEGER(C_INT) :: nmesgs ! Number of object header messages + INTEGER(C_INT) :: nchunks ! Number of object header chunks + INTEGER(C_INT) :: flags ! Object header status flags + TYPE(space_t) :: space + TYPE(mesg_t) :: mesg + END TYPE c_hdr_t + ! Extra metadata storage for obj & attributes TYPE, BIND(C) :: H5_ih_info_t INTEGER(hsize_t) :: index_size ! btree and/or list @@ -83,7 +92,7 @@ MODULE H5O TYPE, BIND(C) :: h5o_info_t INTEGER(C_LONG) :: fileno ! File number that object is located in INTEGER(haddr_t) :: addr ! Object address in file - INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) + INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) INTEGER :: rc ! Reference count of object INTEGER, DIMENSION(8) :: atime ! Access time ! -- NOTE -- @@ -98,6 +107,28 @@ MODULE H5O TYPE(meta_size_t) :: meta_size END TYPE h5o_info_t +! C interoperable structure for h5o_info_t. The Fortran derived type returns the time +! values as an integer array as specified in the Fortran intrinsic DATE_AND_TIME(VALUES). +! Whereas, this derived type does not. + + TYPE, BIND(C) :: c_h5o_info_t + INTEGER(C_LONG) :: fileno ! File number that object is located in + INTEGER(haddr_t) :: addr ! Object address in file + INTEGER(C_INT) :: type ! Basic object type (group, dataset, etc.) + INTEGER(C_INT) :: rc ! Reference count of object + + INTEGER(KIND=TIME_T) :: atime ! Access time + INTEGER(KIND=TIME_T) :: mtime ! modify time + INTEGER(KIND=TIME_T) :: ctime ! create time + INTEGER(KIND=TIME_T) :: btime ! Access time + + INTEGER(hsize_t) :: num_attrs ! # of attributes attached to object + + TYPE(c_hdr_t) :: hdr + + TYPE(meta_size_t) :: meta_size + END TYPE c_h5o_info_t + !***** CONTAINS @@ -834,12 +865,16 @@ CONTAINS ! return_value - returns the return value of the first operator that returns a positive value, or ! zero if all members were processed with no operator returning non-zero. ! hdferr - Returns 0 if successful and -1 if fails +! +! Optional parameters: +! fields - Flags specifying the fields to include in object_info. +! ! AUTHOR ! M. Scot Breitenfeld ! November 19, 2008 ! ! Fortran2003 Interface: - SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr) + SUBROUTINE h5ovisit_f(object_id, index_type, order, op, op_data, return_value, hdferr, fields) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: object_id INTEGER, INTENT(IN) :: index_type @@ -849,10 +884,12 @@ CONTAINS TYPE(C_PTR) :: op_data INTEGER, INTENT(OUT) :: return_value INTEGER, INTENT(OUT) :: hdferr + INTEGER, INTENT(IN), OPTIONAL :: fields !***** + INTEGER :: fields_c INTERFACE - INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data) & + INTEGER FUNCTION h5ovisit_c(object_id, index_type, order, op, op_data, fields) & BIND(C, NAME='h5ovisit_c') IMPORT :: C_FUNPTR, C_PTR IMPORT :: HID_T @@ -862,10 +899,14 @@ CONTAINS INTEGER, INTENT(IN) :: order TYPE(C_FUNPTR), VALUE :: op TYPE(C_PTR), VALUE :: op_data + INTEGER, INTENT(IN) :: fields END FUNCTION h5ovisit_c END INTERFACE - return_value = h5ovisit_c(object_id, index_type, order, op, op_data) + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + + return_value = h5ovisit_c(object_id, index_type, order, op, op_data, fields_c) IF(return_value.GE.0)THEN hdferr = 0 @@ -894,26 +935,29 @@ CONTAINS ! ! Optional parameters: ! lapl_id - Link access property list. +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld ! December 1, 2008 ! ! Fortran2003 Interface: - SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id) + SUBROUTINE h5oget_info_by_name_f(loc_id, name, object_info, hdferr, lapl_id, fields) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default TYPE(C_PTR) :: ptr + INTEGER :: fields_c INTERFACE - INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info) & + INTEGER FUNCTION h5oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, object_info, fields) & BIND(C, NAME='h5oget_info_by_name_c') IMPORT :: c_char, c_ptr IMPORT :: HID_T, SIZE_T @@ -923,10 +967,13 @@ CONTAINS INTEGER(SIZE_T) , INTENT(IN) :: namelen INTEGER(HID_T) , INTENT(IN) :: lapl_id_default TYPE(C_PTR),VALUE :: object_info - + INTEGER , INTENT(IN) :: fields END FUNCTION h5oget_info_by_name_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(name) lapl_id_default = H5P_DEFAULT_F @@ -934,7 +981,7 @@ CONTAINS ptr = C_LOC(object_info) - hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr) + hdferr = H5Oget_info_by_name_c(loc_id, name, namelen, lapl_id_default, ptr, fields_c) END SUBROUTINE H5Oget_info_by_name_f @@ -953,34 +1000,43 @@ CONTAINS ! object_info - Buffer in which to return object information. ! hdferr - Returns 0 if successful and -1 if fails. ! +! Optional parameters: +! fields - Flags specifying the fields to include in object_info. +! ! AUTHOR ! M. Scot Breitenfeld ! May 11, 2012 ! ! Fortran2003 Interface: - SUBROUTINE h5oget_info_f(object_id, object_info, hdferr) + SUBROUTINE h5oget_info_f(object_id, object_info, hdferr, fields) USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: object_id TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr + INTEGER , INTENT(IN), OPTIONAL :: fields !***** TYPE(C_PTR) :: ptr - + INTEGER :: fields_c + INTERFACE - INTEGER FUNCTION h5oget_info_c(object_id, object_info) & + INTEGER FUNCTION h5oget_info_c(object_id, object_info, fields) & BIND(C, NAME='h5oget_info_c') IMPORT :: C_PTR IMPORT :: HID_T IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: object_id TYPE(C_PTR), VALUE :: object_info + INTEGER, INTENT(IN) :: fields END FUNCTION h5oget_info_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + ptr = C_LOC(object_info) - hdferr = H5Oget_info_c(object_id, ptr) + hdferr = H5Oget_info_c(object_id, ptr, fields_c) END SUBROUTINE H5Oget_info_f @@ -1006,6 +1062,7 @@ CONTAINS ! ! Optional parameters: ! lapl_id - Link access property list. (Not currently used.) +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld @@ -1013,7 +1070,7 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, & - object_info, hdferr, lapl_id) + object_info, hdferr, lapl_id, fields) USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -1025,14 +1082,16 @@ CONTAINS TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default TYPE(C_PTR) :: ptr + INTEGER :: fields_c INTERFACE INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, & - index_field, order, n, lapl_id_default, object_info) BIND(C, NAME='h5oget_info_by_idx_c') + index_field, order, n, lapl_id_default, object_info, fields) BIND(C, NAME='h5oget_info_by_idx_c') IMPORT :: c_char, c_ptr, c_funptr IMPORT :: HID_T, SIZE_T, HSIZE_T INTEGER(HID_T) , INTENT(IN) :: loc_id @@ -1043,17 +1102,20 @@ CONTAINS INTEGER(HSIZE_T), INTENT(IN) :: n INTEGER(HID_T) , INTENT(IN) :: lapl_id_default TYPE(C_PTR), VALUE :: object_info - + INTEGER, INTENT(IN) :: fields END FUNCTION h5oget_info_by_idx_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(group_name) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id ptr = C_LOC(object_info) - hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr) + hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr, fields_c) END SUBROUTINE H5Oget_info_by_idx_f @@ -1086,6 +1148,7 @@ CONTAINS ! ! Optional parameters: ! lapl_id - Link access property list identifier. +! fields - Flags specifying the fields to include in object_info. ! ! AUTHOR ! M. Scot Breitenfeld @@ -1093,7 +1156,7 @@ CONTAINS ! ! Fortran2003 Interface: SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_data, & - return_value, hdferr, lapl_id) + return_value, hdferr, lapl_id, fields) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: object_name @@ -1105,14 +1168,16 @@ CONTAINS INTEGER , INTENT(OUT) :: return_value INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id + INTEGER , INTENT(IN) , OPTIONAL :: fields !***** INTEGER(SIZE_T) :: namelen INTEGER(HID_T) :: lapl_id_default + INTEGER :: fields_c INTERFACE INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id) BIND(C, NAME='h5ovisit_by_name_c') + op, op_data, lapl_id, fields) BIND(C, NAME='h5ovisit_by_name_c') IMPORT :: C_CHAR, C_PTR, C_FUNPTR IMPORT :: HID_T, SIZE_T IMPLICIT NONE @@ -1124,16 +1189,20 @@ CONTAINS TYPE(C_FUNPTR) , VALUE :: op TYPE(C_PTR) , VALUE :: op_data INTEGER(HID_T) , INTENT(IN) :: lapl_id + INTEGER , INTENT(IN) :: fields END FUNCTION h5ovisit_by_name_c END INTERFACE + fields_c = H5O_INFO_ALL_F + IF(PRESENT(fields)) fields_c = fields + namelen = LEN(object_name) lapl_id_default = H5P_DEFAULT_F IF(PRESENT(lapl_id)) lapl_id_default = lapl_id return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, & - op, op_data, lapl_id_default) + op, op_data, lapl_id_default, fields_c) IF(return_value.GE.0)THEN hdferr = 0 diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index afb9136..13a2953 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -42,6 +42,14 @@ MODULE H5P USE H5GLOBAL USE H5fortkit + PRIVATE h5pset_fapl_multi_l, h5pset_fapl_multi_s + PRIVATE h5pset_fill_value_integer, h5pset_fill_value_char, h5pset_fill_value_ptr + PRIVATE h5pget_fill_value_integer, h5pget_fill_value_char, h5pget_fill_value_ptr + PRIVATE h5pset_integer, h5pset_char, h5pset_ptr + PRIVATE h5pget_integer, h5pget_char, h5pget_ptr + PRIVATE h5pregister_integer, h5pregister_ptr + PRIVATE h5pinsert_integer, h5pinsert_char, h5pinsert_ptr + INTERFACE h5pset_fapl_multi_f MODULE PROCEDURE h5pset_fapl_multi_l MODULE PROCEDURE h5pset_fapl_multi_s @@ -8015,8 +8023,97 @@ SUBROUTINE h5pget_virtual_dsetname_f(dcpl_id, index, name, hdferr, name_len) END SUBROUTINE h5pget_virtual_dsetname_f +!****s* H5P (F03)/h5pget_dset_no_attrs_hint_f_F03 +! +! NAME +! h5pget_dset_no_attrs_hint_f +! +! PURPOSE +! Gets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! dcpl_id - Target dataset creation property list identifier. +! +! OUTPUTS +! minimize - Value of the setting. +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5pget_dset_no_attrs_hint_f(dcpl_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + LOGICAL , INTENT(OUT) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5pget_dset_no_attrs_hint_c(dcpl_id, minimize) BIND(C, NAME='H5Pget_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dcpl_id + LOGICAL(C_BOOL), INTENT(OUT) :: minimize + END FUNCTION h5pget_dset_no_attrs_hint_c + END INTERFACE + + hdferr = INT(h5pget_dset_no_attrs_hint_c(dcpl_id, c_minimize)) -END MODULE H5P + ! Transfer value of C C_BOOL type to Fortran LOGICAL + minimize = c_minimize + + END SUBROUTINE h5pget_dset_no_attrs_hint_f +!****s* H5P (F03)/h5pset_dset_no_attrs_hint_f_F03 +! +! NAME +! h5pset_dset_no_attrs_hint_f +! +! PURPOSE +! Sets the value of the "minimize dataset headers" value which creates +! smaller dataset object headers when its set and no attributes are present. +! +! INPUTS +! dcpl_id - Target dataset creation property list identifier. +! minimize - Value of the setting. +! +! OUTPUTS +! hdferr - error code: +! 0 on success and -1 on failure +! +! AUTHOR +! Dana Robinson +! January 2019 +! +! Fortran2003 Interface: + SUBROUTINE h5pset_dset_no_attrs_hint_f(dcpl_id, minimize, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: dcpl_id + LOGICAL , INTENT(IN) :: minimize + INTEGER , INTENT(OUT) :: hdferr +!***** + LOGICAL(C_BOOL) :: c_minimize + + INTERFACE + INTEGER FUNCTION h5pset_dset_no_attrs_hint_c(dcpl_id, minimize) BIND(C, NAME='H5Pset_dset_no_attrs_hint') + IMPORT :: HID_T, C_BOOL + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: dcpl_id + LOGICAL(C_BOOL), INTENT(IN), VALUE :: minimize + END FUNCTION h5pset_dset_no_attrs_hint_c + END INTERFACE + + ! Transfer value of Fortran LOGICAL to C C_BOOL type + c_minimize = minimize + hdferr = INT(h5pset_dset_no_attrs_hint_c(dcpl_id, c_minimize)) + + END SUBROUTINE h5pset_dset_no_attrs_hint_f + +END MODULE H5P diff --git a/fortran/src/H5Rff.F90 b/fortran/src/H5Rff.F90 index f5a9c6e..6c2ba28 100644 --- a/fortran/src/H5Rff.F90 +++ b/fortran/src/H5Rff.F90 @@ -56,6 +56,12 @@ MODULE H5R ! END TYPE ! + PRIVATE h5rget_object_type_obj_f + PRIVATE h5rget_region_region_f, h5rget_region_ptr_f + PRIVATE h5rcreate_object_f, h5rcreate_region_f, h5rcreate_ptr_f + PRIVATE h5rdereference_object_f, h5rdereference_region_f, h5rdereference_ptr_f + PRIVATE h5rget_name_object_f, h5rget_name_region_f, h5rget_name_ptr_f + INTERFACE h5rget_object_type_f MODULE PROCEDURE h5rget_object_type_obj_f diff --git a/fortran/src/H5Tff.F90 b/fortran/src/H5Tff.F90 index b63c61d..46c8f39 100644 --- a/fortran/src/H5Tff.F90 +++ b/fortran/src/H5Tff.F90 @@ -41,6 +41,8 @@ MODULE H5T USE H5GLOBAL IMPLICIT NONE + PRIVATE h5tenum_insert_f03, h5tenum_insert_f90 + !****t* H5T/hvl_t ! Fortran2003 Derived Type: TYPE hvl_t diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90 index d4ebdd3..f793b7f 100644 --- a/fortran/src/H5_buildiface.F90 +++ b/fortran/src/H5_buildiface.F90 @@ -135,162 +135,268 @@ PROGRAM H5_buildiface WRITE(11,'(A)') "MODULE H5_GEN" - WRITE(11,'(A)') ' USE, INTRINSIC :: ISO_C_BINDING' - WRITE(11,'(A)') ' USE H5GLOBAL' + WRITE(11,'(2X,A)') 'USE, INTRINSIC :: ISO_C_BINDING' + WRITE(11,'(2X,A)') 'USE H5GLOBAL' + + WRITE(11,'(2X,A)') 'USE H5A' + WRITE(11,'(2X,A)') 'USE H5D' + WRITE(11,'(2X,A)') 'USE H5P' + WRITE(11,'(2X,A)') 'IMPLICIT NONE' + +!****************************** +! DECLARE PRIVATE INTERFACES +!****************************** + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5awrite_ckind_rank"//chr_rank(k) + ENDDO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5aread_ckind_rank"//chr_rank(k) + ENDDO + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dwrite_ckind_rank"//chr_rank(k) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO i = 1, num_ikinds + j = ikind(i) + WRITE(chr2,'(I2)') j + DO k = 1, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + ENDDO + END DO + DO k = 2, 8 + WRITE(11,'(2X,A)') "PRIVATE h5dread_ckind_rank"//chr_rank(k) + ENDDO + + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pset_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pget_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) + END DO + DO i = 1, num_rkinds + j = rkind(i) + WRITE(chr2,'(I2)') j + WRITE(11,'(2X,A)') "PRIVATE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) + END DO - WRITE(11,'(A)') ' USE H5A' - WRITE(11,'(A)') ' USE H5D' - WRITE(11,'(A)') ' USE H5P' - WRITE(11,'(A)') ' IMPLICIT NONE' !*************** ! H5A INTERFACES !*************** ! ! H5Awrite_f ! - WRITE(11,'(A)') " INTERFACE h5awrite_f" + WRITE(11,'(2X,A)') "INTERFACE h5awrite_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5awrite_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Aread_f - WRITE(11,'(A)') " INTERFACE h5aread_f" + WRITE(11,'(2X,A)') "INTERFACE h5aread_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5aread_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5aread_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" !*************** ! H5D INTERFACES !*************** ! ! H5Dwrite_f - WRITE(11,'(A)') " INTERFACE h5dwrite_f" + WRITE(11,'(2X,A)') "INTERFACE h5dwrite_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dwrite_ckind_rank"//chr_rank(k) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Dread_f - WRITE(11,'(A)') " INTERFACE h5dread_f" + WRITE(11,'(2X,A)') "INTERFACE h5dread_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_rkind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO i = 1, num_ikinds j = ikind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_ikind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) ENDDO END DO DO k = 2, 8 - WRITE(11,'(A)') " MODULE PROCEDURE h5dread_ckind_rank"//chr_rank(k) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5dread_ckind_rank"//chr_rank(k) ENDDO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" !*************** ! H5P INTERFACES !*************** ! ! H5Pset_fill_value_f - WRITE(11,'(A)') " INTERFACE h5pset_fill_value_f" + WRITE(11,'(2X,A)') "INTERFACE h5pset_fill_value_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pget_fill_value_f - WRITE(11,'(A)') " INTERFACE h5pget_fill_value_f" + WRITE(11,'(2X,A)') "INTERFACE h5pget_fill_value_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pset_f - WRITE(11,'(A)') " INTERFACE h5pset_f" + WRITE(11,'(2X,A)') "INTERFACE h5pset_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pget_f - WRITE(11,'(A)') " INTERFACE h5pget_f" + WRITE(11,'(2X,A)') "INTERFACE h5pget_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pregister_f - WRITE(11,'(A)') " INTERFACE h5pregister_f" + WRITE(11,'(2X,A)') "INTERFACE h5pregister_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" ! H5Pinsert_f - WRITE(11,'(A)') " INTERFACE h5pinsert_f" + WRITE(11,'(2X,A)') "INTERFACE h5pinsert_f" DO i = 1, num_rkinds j = rkind(i) WRITE(chr2,'(I2)') j - WRITE(11,'(A)') " MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) + WRITE(11,'(5X,A)') "MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) END DO - WRITE(11,'(A)') " END INTERFACE" + WRITE(11,'(2X,A)') "END INTERFACE" WRITE(11,'(A)') 'CONTAINS' diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index 352ffab..69ba8b3 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -556,6 +556,17 @@ h5init_flags_c( int_f *h5d_flags, size_t_f *h5d_size_flags, h5o_flags[24] = (int_f)H5O_TYPE_DATASET; /* Object is a dataset */ h5o_flags[25] = (int_f)H5O_TYPE_NAMED_DATATYPE; /* Object is a named data type */ h5o_flags[26] = (int_f)H5O_TYPE_NTYPES; /* Number of different object types */ + +/* Flags for H5Oget_info. + * These flags determine which fields will be filled in in the H5O_info_t + * struct. + */ + h5o_flags[27] = (int_f)H5O_INFO_ALL; /* (H5O_INFO_BASIC|H5O_INFO_TIME|H5O_INFO_NUM_ATTRS|H5O_INFO_HDR|H5O_INFO_META_SIZE) */ + h5o_flags[28] = (int_f)H5O_INFO_BASIC; /* Fill in the fileno, addr, type, and rc fields */ + h5o_flags[29] = (int_f)H5O_INFO_TIME; /* Fill in the atime, mtime, ctime, and btime fields */ + h5o_flags[30] = (int_f)H5O_INFO_NUM_ATTRS; /* Fill in the num_attrs field */ + h5o_flags[31] = (int_f)H5O_INFO_HDR; /* Fill in the hdr field */ + h5o_flags[32] = (int_f)H5O_INFO_META_SIZE; /* Fill in the meta_size field */ /* * H5P flags */ diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index f63e734..84529e4 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -98,8 +98,8 @@ MODULE H5LIB ! ! H5O flags declaration ! - INTEGER, PARAMETER :: H5O_FLAGS_LEN = 27 - INTEGER, DIMENSION(1:H5O_FLAGS_LEN) :: H5o_flags + INTEGER, PARAMETER :: H5O_FLAGS_LEN = 33 + INTEGER, DIMENSION(1:H5O_FLAGS_LEN) :: H5O_flags ! ! H5P flags declaration ! @@ -139,8 +139,8 @@ MODULE H5LIB ! INTEGER, PARAMETER :: H5LIB_FLAGS_LEN = 2 INTEGER, DIMENSION(1:H5LIB_FLAGS_LEN) :: H5LIB_flags - - PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof + + PUBLIC :: h5open_f, h5close_f, h5get_libversion_f, h5dont_atexit_f, h5kind_to_type, h5offsetof, h5gmtime PUBLIC :: h5garbage_collect_f, h5check_version_f CONTAINS @@ -488,7 +488,13 @@ CONTAINS H5O_TYPE_GROUP_F = h5o_flags(24) H5O_TYPE_DATASET_F = h5o_flags(25) H5O_TYPE_NAMED_DATATYPE_F = h5o_flags(26) - H5O_TYPE_NTYPES_F = h5o_flags(27) + H5O_TYPE_NTYPES_F = h5o_flags(27) + H5O_INFO_ALL_F = h5o_flags(28) + H5O_INFO_BASIC_F = h5o_flags(29) + H5O_INFO_TIME_F = h5o_flags(30) + H5O_INFO_NUM_ATTRS_F = h5o_flags(31) + H5O_INFO_HDR_F = h5o_flags(32) + H5O_INFO_META_SIZE_F = h5o_flags(33) ! ! H5P flags ! @@ -898,4 +904,62 @@ CONTAINS END FUNCTION h5offsetof +!****f* H5LIB_PROVISIONAL/h5gmtime +! +! NAME +! h5gmtime +! +! PURPOSE +! Convert time_t structure (C) to Fortran DATE AND TIME storage format. +! +! Inputs: +! stdtime_t - Object of type time_t that contains a time value +! +! Outputs: +! datetime - A date/time array using Fortran conventions: +! datetime(1) = year +! datetime(2) = month +! datetime(3) = day +! datetime(4) = 0 ! time is expressed as UTC (or GMT timezone) */ +! datetime(5) = hour +! datetime(6) = minute +! datetime(7) = second +! datetime(8) = millisecond -- not available, assigned - HUGE(0) +! +! AUTHOR +! M. Scot Breitenfeld +! January, 2019 +! +! Fortran Interface: + FUNCTION h5gmtime(stdtime_t) + IMPLICIT NONE + INTEGER(KIND=TIME_T), INTENT(IN) :: stdtime_t + INTEGER, DIMENSION(1:8) :: h5gmtime +!***** + TYPE(C_PTR) :: cptr + INTEGER(C_INT), DIMENSION(:), POINTER :: c_time + + INTERFACE + FUNCTION gmtime(stdtime_t) BIND(C, NAME='gmtime') + IMPORT :: TIME_T, C_PTR + IMPLICIT NONE + INTEGER(KIND=TIME_T) :: stdtime_t + TYPE(C_PTR) :: gmtime + END FUNCTION gmtime + END INTERFACE + + cptr = gmtime(stdtime_t) + CALL C_F_POINTER(cptr, c_time, [9]) + + h5gmtime(1) = INT(c_time(6)+1900) ! year starts at 1900 + h5gmtime(2) = INT(c_time(5)+1) ! month starts at 0 in C + h5gmtime(3) = INT(c_time(4)) ! day + h5gmtime(4) = 0 ! time is expressed as UTC (or GMT timezone) + h5gmtime(5) = INT(c_time(3)) ! hour + h5gmtime(6) = INT(c_time(2)) ! minute + h5gmtime(7) = INT(c_time(1)) ! second + h5gmtime(8) = -32767 ! millisecond is not available, assign it -HUGE(0) + + END FUNCTION h5gmtime + END MODULE H5LIB diff --git a/fortran/src/H5config_f.inc.cmake b/fortran/src/H5config_f.inc.cmake index aa3d135..3dd3c8c 100644 --- a/fortran/src/H5config_f.inc.cmake +++ b/fortran/src/H5config_f.inc.cmake @@ -12,7 +12,7 @@ ! fortran/src/H5config_f.inc. Generated from fortran/src/H5config_f.inc.in by configure ! Define if we have parallel support -#cmakedefine01 H5_HAVE_PARALLEL @H5_HAVE_PARALLEL@ +#cmakedefine01 H5_HAVE_PARALLEL #if H5_HAVE_PARALLEL == 0 #undef H5_HAVE_PARALLEL #endif diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index 078778a..b705cc1 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -493,6 +493,13 @@ MODULE H5GLOBAL !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_DATASET_F !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NAMED_DATATYPE_F !DEC$ATTRIBUTES DLLEXPORT :: H5O_TYPE_NTYPES_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_ALL_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_BASIC_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_TIME_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_NUM_ATTRS_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_HDR_F + !DEC$ATTRIBUTES DLLEXPORT :: H5O_INFO_META_SIZE_F + ! !DEC$endif INTEGER :: H5O_COPY_SHALLOW_HIERARCHY_F ! *** THESE VARIABLES DO @@ -522,6 +529,12 @@ MODULE H5GLOBAL INTEGER :: H5O_TYPE_DATASET_F INTEGER :: H5O_TYPE_NAMED_DATATYPE_F INTEGER :: H5O_TYPE_NTYPES_F + INTEGER :: H5O_INFO_ALL_F + INTEGER :: H5O_INFO_BASIC_F + INTEGER :: H5O_INFO_TIME_F + INTEGER :: H5O_INFO_NUM_ATTRS_F + INTEGER :: H5O_INFO_HDR_F + INTEGER :: H5O_INFO_META_SIZE_F ! ! H5P flags declaration ! diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 46ef8ef..fc6567c 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -315,14 +315,14 @@ H5_FCDLL int_f h5oclose_c(hid_t_f *object_id ); H5_FCDLL int_f h5oopen_by_addr_c(hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id); H5_FCDLL int_f h5olink_c(hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); -H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data); +H5_FCDLL int_f h5ovisit_c(hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data, int_f *fields); H5_FCDLL int_f h5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order, - H5O_iterate_t op, void *op_data, hid_t_f *lapl_id ); -H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info); + H5O_iterate_t op, void *op_data, hid_t_f *lapl_id, int_f *fields ); +H5_FCDLL int_f h5oget_info_c(hid_t_f *object_id, H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5oget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *namelen, - int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info); + int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5oget_info_by_name_c(hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, - H5O_info_t_f *object_info); + H5O_info_t_f *object_info, int_f *fields); H5_FCDLL int_f h5ocopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len, hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, hid_t_f *ocpypl_id, hid_t_f *lcpl_id ); diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 7e0b7e8..57f7dda 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -191,6 +191,8 @@ int main(void) } if(sizeof(size_t) == IntKinds_SizeOf[i]) writeTypedef("size_t", "size_t", IntKinds[i]); + if(sizeof(time_t) == IntKinds_SizeOf[i]) + writeTypedef("time_t", "time_t", IntKinds[i]); if(sizeof(hsize_t) == IntKinds_SizeOf[i]) writeTypedef("hsize_t", "hsize_t", IntKinds[i]); } @@ -306,6 +308,17 @@ int main(void) return -1; } + /* time_t */ + for(i=0;i< FORTRAN_NUM_INTEGER_KINDS;i++) { + if(IntKinds_SizeOf[i] == H5_SIZEOF_TIME_T) { + writeToFiles("time_t","TIME_T", "time_t_f", IntKinds[i]); + break; + } + if(i == (FORTRAN_NUM_INTEGER_KINDS-1) ) + /* Error: couldn't find a size for time_t */ + return -1; + } + /* int */ writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_KIND); diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in index 23a6170..777e777 100644 --- a/fortran/src/Makefile.in +++ b/fortran/src/Makefile.in @@ -594,7 +594,6 @@ MAINT = @MAINT@ MAKEINFO = @MAKEINFO@ MANIFEST_TOOL = @MANIFEST_TOOL@ MEMORYALLOCSANITYCHECK = @MEMORYALLOCSANITYCHECK@ -METADATATRACEFILE = @METADATATRACEFILE@ MKDIR_P = @MKDIR_P@ MPE = @MPE@ NM = @NM@ @@ -628,6 +627,7 @@ PAC_FORTRAN_NUM_INTEGER_KINDS = @PAC_FORTRAN_NUM_INTEGER_KINDS@ PARALLEL = @PARALLEL@ PARALLEL_FILTERED_WRITES = @PARALLEL_FILTERED_WRITES@ PATH_SEPARATOR = @PATH_SEPARATOR@ +PREADWRITE = @PREADWRITE@ PROFILING = @PROFILING@ RANLIB = @RANLIB@ ROOT = @ROOT@ @@ -772,29 +772,29 @@ TRACE = perl $(top_srcdir)/bin/trace # .chklog files are output from those tests. # *.clog and *.clog2 are from the MPE option. CHECK_CLEANFILES = *.chkexe *.chklog *.clog *.clog2 -LT_VERS_INTERFACE = 103 +LT_VERS_INTERFACE = 104 LT_VERS_REVISION = 0 -LT_VERS_AGE = 0 -LT_CXX_VERS_INTERFACE = 103 +LT_VERS_AGE = 1 +LT_CXX_VERS_INTERFACE = 104 LT_CXX_VERS_REVISION = 0 -LT_CXX_VERS_AGE = 0 -LT_F_VERS_INTERFACE = 101 -LT_F_VERS_REVISION = 2 -LT_F_VERS_AGE = 1 +LT_CXX_VERS_AGE = 1 +LT_F_VERS_INTERFACE = 102 +LT_F_VERS_REVISION = 0 +LT_F_VERS_AGE = 0 LT_HL_VERS_INTERFACE = 101 -LT_HL_VERS_REVISION = 1 +LT_HL_VERS_REVISION = 2 LT_HL_VERS_AGE = 1 LT_HL_CXX_VERS_INTERFACE = 101 -LT_HL_CXX_VERS_REVISION = 2 +LT_HL_CXX_VERS_REVISION = 3 LT_HL_CXX_VERS_AGE = 1 LT_HL_F_VERS_INTERFACE = 100 -LT_HL_F_VERS_REVISION = 3 +LT_HL_F_VERS_REVISION = 4 LT_HL_F_VERS_AGE = 0 -LT_JAVA_VERS_INTERFACE = 103 +LT_JAVA_VERS_INTERFACE = 104 LT_JAVA_VERS_REVISION = 0 -LT_JAVA_VERS_AGE = 3 +LT_JAVA_VERS_AGE = 4 LT_TOOLS_VERS_INTERFACE = 101 -LT_TOOLS_VERS_REVISION = 1 +LT_TOOLS_VERS_REVISION = 2 LT_TOOLS_VERS_AGE = 1 AM_FCLIBS = $(LIBHDF5) @@ -1680,7 +1680,7 @@ build-check-p: $(LIB) $(PROGS) $(chk_TESTS) echo "**** Hint ****"; \ echo "Parallel test files reside in the current directory" \ "by default."; \ - echo "Set HDF5_PARAPREFIX to use another directory. E.g.,"; \ + echo "Set HDF5_PARAPREFIX to use another directory. e.g.,"; \ echo " HDF5_PARAPREFIX=/PFS/user/me"; \ echo " export HDF5_PARAPREFIX"; \ echo " make check"; \ diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 3a5a91f..b9e2314 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -8,6 +8,7 @@ H5LIB_mp_H5GARBAGE_COLLECT_F H5LIB_mp_H5DONT_ATEXIT_F H5LIB_mp_H5KIND_TO_TYPE H5LIB_mp_H5OFFSETOF +H5LIB_mp_H5GMTIME ; H5A H5A_mp_H5AWRITE_CHAR_SCALAR H5A_mp_H5AREAD_CHAR_SCALAR @@ -98,6 +99,8 @@ H5F_mp_H5FIS_HDF5_F H5F_mp_H5FGET_NAME_F H5F_mp_H5FGET_FILESIZE_F H5F_mp_H5FGET_FILE_IMAGE_F +H5F_mp_H5FGET_DSET_NO_ATTRS_HINT_F +H5F_mp_H5FSET_DSET_NO_ATTRS_HINT_F ; H5G H5G_mp_H5GOPEN_F H5G_mp_H5GCREATE_F @@ -328,6 +331,8 @@ H5P_mp_H5PGET_VIRTUAL_VSPACE_F H5P_mp_H5PGET_VIRTUAL_SRCSPACE_F H5P_mp_H5PGET_VIRTUAL_FILENAME_F H5P_mp_H5PGET_VIRTUAL_DSETNAME_F +H5P_mp_H5PGET_DSET_NO_ATTRS_HINT_F +H5P_mp_H5PSET_DSET_NO_ATTRS_HINT_F ; Parallel @H5_NOPAREXP@H5P_mp_H5PSET_FAPL_MPIO_F @H5_NOPAREXP@H5P_mp_H5PGET_FAPL_MPIO_F |