diff options
Diffstat (limited to 'fortran/src')
38 files changed, 14914 insertions, 0 deletions
diff --git a/fortran/src/Dependencies b/fortran/src/Dependencies new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/fortran/src/Dependencies diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c new file mode 100644 index 0000000..504e937 --- /dev/null +++ b/fortran/src/H5Af.c @@ -0,0 +1,433 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5acreate_c + * Purpose: Call H5Acreate to create an attribute + * Inputs: obj_id - object identifier + * name - name of the attribute + * namelen - name length + * type_id - datatype identifier + * space_id - dataspace identifier + * crt_pr - identifier of creation property list + * Outputs: attr_id - attribute identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5acreate_c (hid_t_f *obj_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *attr_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_obj_id; + hid_t c_type_id; + hid_t c_space_id; + hid_t c_attr_id; + hid_t c_crt_prp; + /* + * Define creation property + */ + c_crt_prp = *crt_prp; + if ( H5P_DEFAULT_F == c_crt_prp ) c_crt_prp = H5P_DEFAULT; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Acreate function. + */ + c_obj_id = *obj_id; + c_type_id = *type_id; + c_space_id = *space_id; + c_attr_id = H5Acreate(c_obj_id, c_name, c_type_id, c_space_id, c_crt_prp); + + + if (c_attr_id < 0) return ret_value; + *attr_id = (hid_t_f)c_attr_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aopen_name _c + * Purpose: Call H5Aopen_name to open an attribute + * Inputs: obj_id - object identifier + * name - name of the attribute + * namelen - name length + * Outputs: attr_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aopen_name_c (hid_t_f *obj_id, _fcd name, int_f *namelen, hid_t_f *attr_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_obj_id; + hid_t c_attr_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + /* + * Call H5Aopen function. + */ + c_obj_id = *obj_id; + c_attr_id = H5Aopen_name(c_obj_id, c_name); + + if (c_attr_id < 0) return ret_value; + *attr_id = (hid_t_f)c_attr_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5awritec_c + * Purpose: Call h5awrite_c to write a character attribute + * Inputs: attr_id - dataset identifier + * mem_type_id - memory datatype identifier + * buf - character data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday , August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5awritec_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf) +{ + int ret_value = -1; + + /* + * Call h5awrite_c function. + */ + ret_value = nh5awrite_c(attr_id, mem_type_id, _fcdtocp(buf)); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5awrite_c + * Purpose: Call H5Awrite to write a attribute + * Inputs: attr_id - attribute identifier + * mem_type_id - memory datatype identifier + * buf - data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5awrite_c (hid_t_f *attr_id, hid_t_f *mem_type_id, void *buf) +{ + int ret_value = -1; + herr_t ret; + hid_t c_attr_id; + hid_t c_mem_type_id; + + /* + * Call H5Awrite function. + */ + c_attr_id = *attr_id; + c_mem_type_id = *mem_type_id; + ret = H5Awrite(c_attr_id, c_mem_type_id, buf); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5areadc_c + * Purpose: Call h5aread_c to read character attribute + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * Outputs: buf - character data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5areadc_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf) +{ + int ret_value = -1; + + /* + * Call h5aread_c function. + */ + ret_value = nh5aread_c(attr_id, mem_type_id, (_fcdtocp(buf))); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aread_c + * Purpose: Call H5Araed to read an attribute + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * Outputs: buf - data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aread_c (hid_t_f *attr_id, hid_t_f *mem_type_id, void *buf) +{ + int ret_value = -1; + herr_t ret; + hid_t c_attr_id; + hid_t c_mem_type_id; + + /* + * Call H5Aread function. + */ + c_attr_id = *attr_id; + c_mem_type_id = *mem_type_id; + ret = H5Aread(c_attr_id, c_mem_type_id, buf); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aclose_c + * Purpose: Call H5Aclose to close an attribute + * Inputs: attr_id - identifier of an attribute to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5aclose_c ( hid_t_f *attr_id ) +{ + int ret_value = 0; + hid_t c_attr_id; + c_attr_id = *attr_id; + if ( H5Aclose(c_attr_id) < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5adelete_c + * Purpose: Call H5Adelete to delete an attribute + * Inputs: obj_id - object identifier + * name - name of the attribute + * namelen - name length + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5adelete_c (hid_t_f *obj_id, _fcd name, int_f *namelen) +{ + int ret_value = -1; + herr_t status; + hid_t c_obj_id; + char *c_name; + int c_namelen; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Adelete function. + */ + c_obj_id = *obj_id; + status = H5Adelete(c_obj_id, c_name); + + if (status < 0) return ret_value; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5aopen_idx_c + * Purpose: Call H5Aopen_idx to open an attribute + * Inputs: obj_id - object identifier + * idx - attribute index ( zero based) + * Outputs: attr_id - attribute identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aopen_idx_c (hid_t_f *obj_id, int_f *idx, hid_t_f *attr_id) +{ + int ret_value = -1; + hid_t c_obj_id; + hid_t c_attr_id; + unsigned c_idx; + c_idx = (unsigned)*idx; + + /* + * Call H5Aopen_idx function. + */ + c_obj_id = *obj_id; + c_attr_id = H5Aopen_idx(c_obj_id, c_idx); + + if (c_attr_id < 0) return ret_value; + *attr_id = (hid_t_f)c_attr_id; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5aget_space_c + * Purpose: Call H5Aget_space to get attribute's dataspace + * Inputs: attr_id - attribute identifier + * Outputs: space_id - dataspace identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aget_space_c (hid_t_f *attr_id, hid_t_f *space_id) +{ + int ret_value = -1; + hid_t c_attr_id; + hid_t c_space_id; + + /* + * Call H5Aget_space function. + */ + c_attr_id = *attr_id; + c_space_id = H5Aget_space(c_attr_id); + + if (c_space_id < 0) return ret_value; + *space_id = (hid_t_f)c_space_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_type_c + * Purpose: Call H5Aget_space to get attribute's datatype + * Inputs: attr_id - attribute identifier + * Outputs: type_id - datatype identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aget_type_c (hid_t_f *attr_id, hid_t_f *type_id) +{ + int ret_value = -1; + hid_t c_attr_id; + hid_t c_type_id; + + /* + * Call H5Aget_type function. + */ + c_attr_id = *attr_id; + c_type_id = H5Aget_type(c_attr_id); + + if (c_type_id < 0) return ret_value; + *type_id = (hid_t_f)c_type_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_num_attrs_c + * Purpose: Call H5Aget_num_attrs to determine number of + * attributes of an object + * Inputs: obj_id - object identifier + * attr_num - number of attributes + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aget_num_attrs_c (hid_t_f *obj_id, int_f *attr_num) +{ + int ret_value = -1; + hid_t c_obj_id; + int c_attr_num; + + /* + * Call H5Aget_num_attrs function. + */ + c_obj_id = *obj_id; + c_attr_num = H5Aget_num_attrs(c_obj_id); + + if (c_attr_num < 0) return ret_value; + *attr_num = c_attr_num; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5aget_name_c + * Purpose: Call H5Aget_name to get attribute's name + * Inputs: attr_id - attribute identifier + * bufsize -size of the buffer + * Outputs: buf - buffer to hold the name + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aget_name_c(hid_t_f *attr_id, size_t_f *bufsize, _fcd buf) +{ + int ret_value = -1; + hid_t c_attr_id; + ssize_t c_size; + size_t c_bufsize; + char *c_buf =NULL; + + /* + * Allocate buffer to hold name of an attribute + */ + c_bufsize = *bufsize; + c_buf = (char *)HDmalloc(c_bufsize +1); + if (c_buf == NULL) return ret_value; + + /* + * Call H5Aget_name function + */ + c_attr_id = *attr_id; + c_size = H5Aget_name(c_attr_id, c_bufsize, c_buf); + if (c_size < 0) return ret_value; + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + + HDpackFstring(c_buf, _fcdtocp(buf), c_bufsize); + HDfree( c_buf); + ret_value = c_size; + return ret_value; +} diff --git a/fortran/src/H5Aff.f90 b/fortran/src/H5Aff.f90 new file mode 100644 index 0000000..b24de00 --- /dev/null +++ b/fortran/src/H5Aff.f90 @@ -0,0 +1,1024 @@ +! +! This file contains Fortran90 interfaces for H5A functions. +! + MODULE H5A + + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + INTERFACE h5awrite_f + + MODULE PROCEDURE h5awrite_integer_scalar + MODULE PROCEDURE h5awrite_integer_1 + MODULE PROCEDURE h5awrite_integer_2 + MODULE PROCEDURE h5awrite_integer_3 + MODULE PROCEDURE h5awrite_integer_4 + MODULE PROCEDURE h5awrite_integer_5 + MODULE PROCEDURE h5awrite_integer_6 + MODULE PROCEDURE h5awrite_integer_7 + MODULE PROCEDURE h5awrite_char_scalar + MODULE PROCEDURE h5awrite_char_1 + MODULE PROCEDURE h5awrite_char_2 + MODULE PROCEDURE h5awrite_char_3 + MODULE PROCEDURE h5awrite_char_4 + MODULE PROCEDURE h5awrite_char_5 + MODULE PROCEDURE h5awrite_char_6 + MODULE PROCEDURE h5awrite_char_7 + MODULE PROCEDURE h5awrite_real_scalar + MODULE PROCEDURE h5awrite_real_1 + MODULE PROCEDURE h5awrite_real_2 + MODULE PROCEDURE h5awrite_real_3 + MODULE PROCEDURE h5awrite_real_4 + MODULE PROCEDURE h5awrite_real_5 + MODULE PROCEDURE h5awrite_real_6 + MODULE PROCEDURE h5awrite_real_7 +! Comment if on T3E + MODULE PROCEDURE h5awrite_double_scalar + MODULE PROCEDURE h5awrite_double_1 + MODULE PROCEDURE h5awrite_double_2 + MODULE PROCEDURE h5awrite_double_3 + MODULE PROCEDURE h5awrite_double_4 + MODULE PROCEDURE h5awrite_double_5 + MODULE PROCEDURE h5awrite_double_6 + MODULE PROCEDURE h5awrite_double_7 +! End commnet if on T3E + + END INTERFACE + + INTERFACE h5aread_f + + MODULE PROCEDURE h5aread_integer_scalar + MODULE PROCEDURE h5aread_integer_1 + MODULE PROCEDURE h5aread_integer_2 + MODULE PROCEDURE h5aread_integer_3 + MODULE PROCEDURE h5aread_integer_4 + MODULE PROCEDURE h5aread_integer_5 + MODULE PROCEDURE h5aread_integer_6 + MODULE PROCEDURE h5aread_integer_7 + MODULE PROCEDURE h5aread_char_scalar + MODULE PROCEDURE h5aread_char_1 + MODULE PROCEDURE h5aread_char_2 + MODULE PROCEDURE h5aread_char_3 + MODULE PROCEDURE h5aread_char_4 + MODULE PROCEDURE h5aread_char_5 + MODULE PROCEDURE h5aread_char_6 + MODULE PROCEDURE h5aread_char_7 + MODULE PROCEDURE h5aread_real_scalar + MODULE PROCEDURE h5aread_real_1 + MODULE PROCEDURE h5aread_real_2 + MODULE PROCEDURE h5aread_real_3 + MODULE PROCEDURE h5aread_real_4 + MODULE PROCEDURE h5aread_real_5 + MODULE PROCEDURE h5aread_real_6 + MODULE PROCEDURE h5aread_real_7 +! Comment if on T3E + MODULE PROCEDURE h5aread_double_scalar + MODULE PROCEDURE h5aread_double_2 + MODULE PROCEDURE h5aread_double_3 + MODULE PROCEDURE h5aread_double_4 + MODULE PROCEDURE h5aread_double_5 + MODULE PROCEDURE h5aread_double_6 + MODULE PROCEDURE h5aread_double_7 +! End commnet if on T3E + END INTERFACE + + CONTAINS + SUBROUTINE h5acreate_f(obj_id, name, type_id, space_id, attr_id, & + hdferr, creation_prp) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Attribute name + INTEGER(HID_T), INTENT(IN) :: type_id + ! Attribute datatype identifier + INTEGER(HID_T), INTENT(IN) :: space_id + ! Attribute dataspace identifier + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp + ! Attribute creation property + ! list identifier + INTEGER :: creation_prp_default + INTEGER :: namelen + INTEGER, EXTERNAL :: h5acreate_c + creation_prp_default = H5P_DEFAULT_F + namelen = LEN(NAME) + if (present(creation_prp)) creation_prp_default = creation_prp + hdferr = h5acreate_c(obj_id, name, namelen, type_id, space_id, & + creation_prp_default, attr_id) + END SUBROUTINE h5acreate_f + + + + SUBROUTINE h5aopen_name_f(obj_id, name, attr_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Attribute name + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5aopen_name_c + namelen = LEN(name) + hdferr = h5aopen_name_c(obj_id, name, namelen, attr_id) + END SUBROUTINE h5aopen_name_f + + + + SUBROUTINE h5aopen_idx_f(obj_id, index, attr_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + INTEGER, INTENT(IN) :: index ! Attribute index + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aopen_idx_c + hdferr = h5aopen_idx_c(obj_id, index, attr_id) + END SUBROUTINE h5aopen_idx_f + + + + SUBROUTINE h5awrite_integer_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, INTENT(IN) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_scalar + + SUBROUTINE h5awrite_integer_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_1 + + + SUBROUTINE h5awrite_integer_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_2 + + + SUBROUTINE h5awrite_integer_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_3 + + + SUBROUTINE h5awrite_integer_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_4 + + + SUBROUTINE h5awrite_integer_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_5 + + + SUBROUTINE h5awrite_integer_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_6 + + + SUBROUTINE h5awrite_integer_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_integer_7 + + + SUBROUTINE h5awrite_real_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, INTENT(IN) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_scalar + + SUBROUTINE h5awrite_real_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_1 + + + SUBROUTINE h5awrite_real_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_2 + + + SUBROUTINE h5awrite_real_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_3 + + + SUBROUTINE h5awrite_real_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_4 + + + SUBROUTINE h5awrite_real_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_5 + + + SUBROUTINE h5awrite_real_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_6 + + + SUBROUTINE h5awrite_real_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_real_7 + + + SUBROUTINE h5awrite_double_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, INTENT(IN) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_scalar + + SUBROUTINE h5awrite_double_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_1 + + + SUBROUTINE h5awrite_double_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_2 + + + SUBROUTINE h5awrite_double_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_3 + + + SUBROUTINE h5awrite_double_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_4 + + + SUBROUTINE h5awrite_double_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_5 + + + SUBROUTINE h5awrite_double_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_6 + + + SUBROUTINE h5awrite_double_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awrite_c + hdferr = h5awrite_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_double_7 + + SUBROUTINE h5awrite_char_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*),INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_scalar + + SUBROUTINE h5awrite_char_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(*), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_1 + + + SUBROUTINE h5awrite_char_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_2 + + + SUBROUTINE h5awrite_char_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_3 + + + SUBROUTINE h5awrite_char_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_4 + + + SUBROUTINE h5awrite_char_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_5 + + + SUBROUTINE h5awrite_char_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_6 + + + SUBROUTINE h5awrite_char_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5awritec_c + hdferr = h5awritec_c(attr_id, memtype_id, buf) + END SUBROUTINE h5awrite_char_7 + + + SUBROUTINE h5aread_integer_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, INTENT(OUT) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_scalar + + SUBROUTINE h5aread_integer_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_1 + + + SUBROUTINE h5aread_integer_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_2 + + + SUBROUTINE h5aread_integer_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_3 + + + SUBROUTINE h5aread_integer_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_4 + + + SUBROUTINE h5aread_integer_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_5 + + + SUBROUTINE h5aread_integer_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_6 + + + SUBROUTINE h5aread_integer_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER, DIMENSION(:,:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_integer_7 + + + SUBROUTINE h5aread_real_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, INTENT(OUT) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_scalar + + SUBROUTINE h5aread_real_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_1 + + + SUBROUTINE h5aread_real_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_2 + + + SUBROUTINE h5aread_real_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_3 + + + SUBROUTINE h5aread_real_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_4 + + + SUBROUTINE h5aread_real_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_5 + + + SUBROUTINE h5aread_real_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_6 + + + SUBROUTINE h5aread_real_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + REAL, DIMENSION(:,:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_real_7 + + + SUBROUTINE h5aread_double_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, INTENT(OUT) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_scalar + + SUBROUTINE h5aread_double_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_1 + + + SUBROUTINE h5aread_double_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_2 + + + SUBROUTINE h5aread_double_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_3 + + + SUBROUTINE h5aread_double_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_4 + + + SUBROUTINE h5aread_double_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_5 + + + SUBROUTINE h5aread_double_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_6 + + + SUBROUTINE h5aread_double_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + DOUBLE PRECISION, DIMENSION(:,:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aread_c + hdferr = h5aread_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_double_7 + + SUBROUTINE h5aread_char_scalar(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_scalar + + + SUBROUTINE h5aread_char_1(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_1 + + + SUBROUTINE h5aread_char_2(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_2 + + + SUBROUTINE h5aread_char_3(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_3 + + + SUBROUTINE h5aread_char_4(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_4 + + + SUBROUTINE h5aread_char_5(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_5 + + + SUBROUTINE h5aread_char_6(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_6 + + + SUBROUTINE h5aread_char_7(attr_id, memtype_id, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + CHARACTER(LEN=*), DIMENSION(:,:,:,:,:,:,:), INTENT(OUT) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5areadc_c + hdferr = h5areadc_c(attr_id, memtype_id, buf) + END SUBROUTINE h5aread_char_7 + + + SUBROUTINE h5aget_space_f(attr_id, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(OUT) :: space_id + ! Attribute dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL:: h5aget_space_c + hdferr = h5aget_space_c(attr_id, space_id) + END SUBROUTINE h5aget_space_f + + + SUBROUTINE h5aget_type_f(attr_id, type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(OUT) :: type_id + ! Attribute datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aget_type_c + hdferr = h5aget_type_c(attr_id, type_id) + END SUBROUTINE h5aget_type_f + + + + SUBROUTINE h5aget_name_f(attr_id, size, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER, INTENT(IN) :: size ! Buffer size + CHARACTER(LEN=*), INTENT(OUT) :: buf + ! Buffer to hold attribute name + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! name length is successful, + ! -1 if fail + INTEGER, EXTERNAL :: h5aget_name_c + hdferr = h5aget_name_c(attr_id, size, buf) + END SUBROUTINE h5aget_name_f + + + + SUBROUTINE h5aget_num_attrs_f(obj_id, attr_num, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + INTEGER, INTENT(OUT) :: attr_num ! Number of attributes of the + ! object + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5aget_num_attrs_c + hdferr = h5aget_num_attrs_c(obj_id, attr_num) + END SUBROUTINE h5aget_num_attrs_f + + + SUBROUTINE h5adelete_f(obj_id, name, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Attribute name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5adelete_c + namelen = LEN(name) + hdferr = h5adelete_c(obj_id, name, namelen) + END SUBROUTINE h5adelete_f + + + SUBROUTINE h5aclose_f(attr_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code: + INTEGER, EXTERNAL :: h5aclose_c + hdferr = h5aclose_c(attr_id) + END SUBROUTINE h5aclose_f + + END MODULE H5A diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c new file mode 100644 index 0000000..968e9a1 --- /dev/null +++ b/fortran/src/H5Df.c @@ -0,0 +1,391 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5dcreate_c + * Purpose: Call H5Dcreate to create a dataset + * Inputs: loc_id - file or group identifier + * name - name of the dataset + * namelen - name length + * type_id - datatype identifier + * space_id - dataspace identifier + * crt_pr - identifier of creation property list + * Outputs: dset_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 4, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *dset_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_loc_id; + hid_t c_type_id; + hid_t c_space_id; + hid_t c_dset_id; + hid_t c_crt_prp; + + /* + * Define creation property + */ + c_crt_prp = *crt_prp; + if ( H5P_DEFAULT_F == c_crt_prp ) c_crt_prp = H5P_DEFAULT; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Dcreate function. + */ + c_loc_id = *loc_id; + c_type_id = *type_id; + c_space_id = *space_id; + c_dset_id = H5Dcreate(c_loc_id, c_name, c_type_id, c_space_id, c_crt_prp); + if (c_dset_id < 0) return ret_value; + *dset_id = (hid_t_f)c_dset_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dopen_c + * Purpose: Call H5Dopen to open a dataset + * Inputs: loc_id - file or group identifier + * name - name of the dataset + * namelen - name length + * Outputs: dset_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 4, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_loc_id; + hid_t c_dset_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Dopen function. + */ + c_loc_id = *loc_id; + c_dset_id = H5Dopen(c_loc_id, c_name); + + if (c_dset_id < 0) return ret_value; + *dset_id = (hid_t_f)c_dset_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dwritec_c + * Purpose: Call h5dwrite_c to write a dataset of characters + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * mem_space_id - memory dataspace identifier + * file_space_id - memory dataspace identifier + * xfer_pr - identifier of transfer property list + * buf - character data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 6, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dwritec_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, _fcd buf) +{ + int ret_value = -1; + + /* + * Call h5dwrite_c function. + */ + ret_value = nh5dwrite_c(dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp, _fcdtocp(buf)); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dwrite_c + * Purpose: Call H5Dwrite to write a dataset + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * mem_space_id - memory dataspace identifier + * file_space_id - memory dataspace identifier + * xfer_pr - identifier of transfer property list + * buf - data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 6, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dwrite_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf) +{ + int ret_value = -1; + herr_t ret; + hid_t c_dset_id; + hid_t c_mem_type_id; + hid_t c_mem_space_id; + hid_t c_file_space_id; + hid_t c_xfer_prp; + + /* + * Define transfer property + */ + c_xfer_prp = *xfer_prp; + if ( H5P_DEFAULT_F == c_xfer_prp ) c_xfer_prp = H5P_DEFAULT; + + /* + * Call H5Dwrite function. + */ + c_dset_id = *dset_id; + c_mem_type_id = *mem_type_id; + c_mem_space_id = *mem_space_id; + c_file_space_id = *file_space_id; + ret = H5Dwrite(c_dset_id, c_mem_type_id, c_mem_space_id, c_file_space_id, c_xfer_prp, buf); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5dreadc_c + * Purpose: Call h5dread_c to read a dataset of characters + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * mem_space_id - memory dataspace identifier + * file_space_id - memory dataspace identifier + * xfer_pr - identifier of transfer property list + * Outputs: buf - character data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Monday, August 9, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dreadc_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, _fcd buf) +{ + int ret_value = -1; + + /* + * Call h5dread_c function. + */ + ret_value = nh5dread_c(dset_id, mem_type_id, mem_space_id, file_space_id, xfer_prp, _fcdtocp(buf)); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dread_c + * Purpose: Call H5Draed to read a dataset + * Inputs: dset_id - dataset identifier + * mem_type_id - memory datatype identifier + * mem_space_id - memory dataspace identifier + * file_space_id - memory dataspace identifier + * xfer_pr - identifier of transfer property list + * Outputs: buf - data buffer + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Monday, August 9, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5dread_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf) +{ + int ret_value = -1; + herr_t ret; + hid_t c_dset_id; + hid_t c_mem_type_id; + hid_t c_mem_space_id; + hid_t c_file_space_id; + hid_t c_xfer_prp; + + /* + * Define transfer property + */ + c_xfer_prp = *xfer_prp; + if ( H5P_DEFAULT_F == c_xfer_prp ) c_xfer_prp = H5P_DEFAULT; + + /* + * Call H5Dread function. + */ + c_dset_id = *dset_id; + c_mem_type_id = *mem_type_id; + c_mem_space_id = *mem_space_id; + c_file_space_id = *file_space_id; + ret = H5Dread(c_dset_id, c_mem_type_id, c_mem_space_id, c_file_space_id, c_xfer_prp, buf); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dclose_c + * Purpose: Call H5Dclose to close a dataset + * Inputs: dset_id - identifier of the dataset to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 4, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5dclose_c ( hid_t_f *dset_id ) +{ + int ret_value = 0; + hid_t c_dset_id; + c_dset_id = *dset_id; + if ( H5Dclose(c_dset_id) < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dget_space_c + * Purpose: Call H5Dget_space to obtain dataspace of a dataset + * Inputs: dset_id - identifier of the dataset + * Outputs: space_id - identifier of the dataset's dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 19, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5dget_space_c ( hid_t_f *dset_id , hid_t_f *space_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hid_t c_space_id; + + c_dset_id = *dset_id; + c_space_id = H5Dget_space(c_dset_id); + if(c_space_id < 0 ) return ret_value; + ret_value = 0; + *space_id = (hid_t_f)c_space_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dget_type_c + * Purpose: Call H5Dget_type to obtain datatype of a dataset + * Inputs: dset_id - identifier of the dataset + * Outputs: type_id - identifier of the dataset's datatype + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 19, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5dget_type_c ( hid_t_f *dset_id , hid_t_f *type_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hid_t c_type_id; + + c_dset_id = *dset_id; + c_type_id = H5Dget_type(c_dset_id); + + if(c_type_id < 0 ) return ret_value; + + *type_id = (hid_t_f)c_type_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5dget_create_plist_c + * Purpose: Call H5Dget_create_plist to obtain creation property list + * of a dataset + * Inputs: dset_id - identifier of the dataset + * Outputs: plist_id - identifier of he dataset creation property list + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 19, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5dget_create_plist_c ( hid_t_f *dset_id , hid_t_f *plist_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hid_t c_plist_id; + + c_dset_id = *dset_id; + c_plist_id = H5Dget_create_plist(c_dset_id); + + if(c_plist_id < 0 ) return ret_value; + + ret_value = 0; + *plist_id = (hid_t_f)c_plist_id; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5dextend_c + * Purpose: Call H5Dextend to extend dataset with unlimited dimensions + * Inputs: dset_id - identifier of the dataset + * Outputs: dims - array with the dimension sizes + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, August 19, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims) +{ + int ret_value = -1; + hsize_t *c_dims; + int status; + int rank; + int i; + hid_t c_dset_id; + hid_t c_space_id; + + c_dset_id = *dset_id; + c_space_id = H5Dget_space(c_dset_id); + if (c_space_id < 0) return ret_value; + + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0) return ret_value; + + c_dims = malloc(sizeof(hsize_t)*rank); + if (!c_dims) return ret_value; + + /* + * Reverse dimensions due to C-FORTRAN storage order. + */ + for (i=0; i < rank; i++) + c_dims[i] = dims[rank - i - 1]; + + status = H5Dextend(c_dset_id, c_dims); + + if ( status >= 0 ) ret_value = 0; + HDfree(c_dims); + return ret_value; +} + diff --git a/fortran/src/H5Dff.f90 b/fortran/src/H5Dff.f90 new file mode 100644 index 0000000..5af83b8 --- /dev/null +++ b/fortran/src/H5Dff.f90 @@ -0,0 +1,2441 @@ +! +! This file contains Fortran90 interfaces for H5D functions. +! + MODULE H5D + USE H5FORTRAN_TYPES +! USE H5FORTRAN_FLAGS - do not need it here since it is included in H5R already + USE H5R + + INTERFACE h5dwrite_f + + MODULE PROCEDURE h5dwrite_reference_obj + MODULE PROCEDURE h5dwrite_reference_dsetreg + MODULE PROCEDURE h5dwrite_integer_scalar + MODULE PROCEDURE h5dwrite_integer_1 + MODULE PROCEDURE h5dwrite_integer_2 + MODULE PROCEDURE h5dwrite_integer_3 + MODULE PROCEDURE h5dwrite_integer_4 + MODULE PROCEDURE h5dwrite_integer_5 + MODULE PROCEDURE h5dwrite_integer_6 + MODULE PROCEDURE h5dwrite_integer_7 + MODULE PROCEDURE h5dwrite_char_scalar + MODULE PROCEDURE h5dwrite_char_1 + MODULE PROCEDURE h5dwrite_char_2 + MODULE PROCEDURE h5dwrite_char_3 + MODULE PROCEDURE h5dwrite_char_4 + MODULE PROCEDURE h5dwrite_char_5 + MODULE PROCEDURE h5dwrite_char_6 + MODULE PROCEDURE h5dwrite_char_7 + MODULE PROCEDURE h5dwrite_real_scalar + MODULE PROCEDURE h5dwrite_real_1 + MODULE PROCEDURE h5dwrite_real_2 + MODULE PROCEDURE h5dwrite_real_3 + MODULE PROCEDURE h5dwrite_real_4 + MODULE PROCEDURE h5dwrite_real_5 + MODULE PROCEDURE h5dwrite_real_6 + MODULE PROCEDURE h5dwrite_real_7 +! Comment if on T3E + MODULE PROCEDURE h5dwrite_double_scalar + MODULE PROCEDURE h5dwrite_double_1 + MODULE PROCEDURE h5dwrite_double_2 + MODULE PROCEDURE h5dwrite_double_3 + MODULE PROCEDURE h5dwrite_double_4 + MODULE PROCEDURE h5dwrite_double_5 + MODULE PROCEDURE h5dwrite_double_6 + MODULE PROCEDURE h5dwrite_double_7 +! End comment if on T3E + END INTERFACE + + INTERFACE h5dread_f + + MODULE PROCEDURE h5dread_reference_obj + MODULE PROCEDURE h5dread_reference_dsetreg + MODULE PROCEDURE h5dread_integer_scalar + MODULE PROCEDURE h5dread_integer_1 + MODULE PROCEDURE h5dread_integer_2 + MODULE PROCEDURE h5dread_integer_3 + MODULE PROCEDURE h5dread_integer_4 + MODULE PROCEDURE h5dread_integer_5 + MODULE PROCEDURE h5dread_integer_6 + MODULE PROCEDURE h5dread_integer_7 + MODULE PROCEDURE h5dread_char_scalar + MODULE PROCEDURE h5dread_char_1 + MODULE PROCEDURE h5dread_char_2 + MODULE PROCEDURE h5dread_char_3 + MODULE PROCEDURE h5dread_char_4 + MODULE PROCEDURE h5dread_char_5 + MODULE PROCEDURE h5dread_char_6 + MODULE PROCEDURE h5dread_char_7 + MODULE PROCEDURE h5dread_real_scalar + MODULE PROCEDURE h5dread_real_1 + MODULE PROCEDURE h5dread_real_2 + MODULE PROCEDURE h5dread_real_3 + MODULE PROCEDURE h5dread_real_4 + MODULE PROCEDURE h5dread_real_5 + MODULE PROCEDURE h5dread_real_6 + MODULE PROCEDURE h5dread_real_7 +! Comment if on T3E + MODULE PROCEDURE h5dread_double_scalar + MODULE PROCEDURE h5dread_double_1 + MODULE PROCEDURE h5dread_double_2 + MODULE PROCEDURE h5dread_double_3 + MODULE PROCEDURE h5dread_double_4 + MODULE PROCEDURE h5dread_double_5 + MODULE PROCEDURE h5dread_double_6 + MODULE PROCEDURE h5dread_double_7 +! End comment if on T3E + + END INTERFACE + + CONTAINS + + + SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, & + hdferr, creation_prp) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HID_T), INTENT(OUT) :: dset_id ! Dataset identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp + ! Dataset creation propertly + ! list identifier + INTEGER :: creation_prp_default + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5dcreate_c + + creation_prp_default = H5P_DEFAULT_F + if (present(creation_prp)) creation_prp_default = creation_prp + namelen = LEN(name) + hdferr = h5dcreate_c(loc_id, name, namelen, type_id, space_id, & + creation_prp_default, dset_id) + END SUBROUTINE h5dcreate_f + + SUBROUTINE h5dopen_f(loc_id, name, dset_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset + INTEGER(HID_T), INTENT(OUT) :: dset_id ! Dataset identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5dopen_c + namelen = LEN(name) + hdferr = h5dopen_c(loc_id, name, namelen, dset_id) + + END SUBROUTINE h5dopen_f + + SUBROUTINE h5dclose_f(dset_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5dclose_c + + hdferr = h5dclose_c(dset_id) + + END SUBROUTINE h5dclose_f + + SUBROUTINE h5dwrite_reference_obj(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + TYPE(hobj_ref_t_f), DIMENSION(:), INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_reference_obj + + SUBROUTINE h5dwrite_reference_dsetreg(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + TYPE(hdset_reg_ref_t_f), DIMENSION(:), INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_reference_dsetreg + + + SUBROUTINE h5dwrite_integer_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_integer_scalar + + SUBROUTINE h5dwrite_integer_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_integer_1 + + SUBROUTINE h5dwrite_integer_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_2 + + SUBROUTINE h5dwrite_integer_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_3 + + SUBROUTINE h5dwrite_integer_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default = H5P_DEFAULT_F + INTEGER(HID_T) :: mem_space_id_default = H5S_ALL_F + INTEGER(HID_T) :: file_space_id_default = H5S_ALL_F + INTEGER, EXTERNAL :: h5dwrite_c + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_4 + + SUBROUTINE h5dwrite_integer_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_5 + + SUBROUTINE h5dwrite_integer_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_6 + + SUBROUTINE h5dwrite_integer_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(IN), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dwrite_integer_7 + + + SUBROUTINE h5dwrite_char_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_scalar + + SUBROUTINE h5dwrite_char_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(*) :: buf ! Data buffer + ! CHARACTER, INTENT(IN), DIMENSION(*) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_1 + + SUBROUTINE h5dwrite_char_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_2 + + SUBROUTINE h5dwrite_char_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_3 + + SUBROUTINE h5dwrite_char_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_4 + + SUBROUTINE h5dwrite_char_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_5 + + SUBROUTINE h5dwrite_char_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_6 + + SUBROUTINE h5dwrite_char_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(IN), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwritec_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwritec_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_char_7 + + SUBROUTINE h5dwrite_real_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default = H5P_DEFAULT_F + INTEGER(HID_T) :: mem_space_id_default = H5S_ALL_F + INTEGER(HID_T) :: file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_scalar + + SUBROUTINE h5dwrite_real_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_1 + + SUBROUTINE h5dwrite_real_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_2 + + SUBROUTINE h5dwrite_real_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_3 + + SUBROUTINE h5dwrite_real_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_4 + + SUBROUTINE h5dwrite_real_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_5 + + SUBROUTINE h5dwrite_real_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_6 + + SUBROUTINE h5dwrite_real_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(IN), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dwrite_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_real_7 + + + SUBROUTINE h5dwrite_double_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_scalar + + SUBROUTINE h5dwrite_double_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_1 + + SUBROUTINE h5dwrite_double_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_2 + + SUBROUTINE h5dwrite_double_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_3 + + SUBROUTINE h5dwrite_double_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_4 + + SUBROUTINE h5dwrite_double_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_5 + + SUBROUTINE h5dwrite_double_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:,:,:,:,:) :: buf + ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_6 + + SUBROUTINE h5dwrite_double_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(IN), DIMENSION(:,:,:,:,:,:,:) :: buf + ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dwrite_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dwrite_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dwrite_double_7 + + SUBROUTINE h5dread_reference_obj(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + TYPE(hobj_ref_t_f), DIMENSION(:), INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_reference_obj + + SUBROUTINE h5dread_reference_dsetreg(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + TYPE(hdset_reg_ref_t_f), DIMENSION(:), INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_reference_dsetreg + + + SUBROUTINE h5dread_integer_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_integer_scalar + + SUBROUTINE h5dread_integer_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_integer_1 + + SUBROUTINE h5dread_integer_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_2 + + SUBROUTINE h5dread_integer_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_3 + + SUBROUTINE h5dread_integer_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_4 + + SUBROUTINE h5dread_integer_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_5 + + SUBROUTINE h5dread_integer_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_6 + + SUBROUTINE h5dread_integer_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + INTEGER, INTENT(INOUT), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, & + buf) + + END SUBROUTINE h5dread_integer_7 + + SUBROUTINE h5dread_char_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_scalar + + SUBROUTINE h5dread_char_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(*) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_1 + + SUBROUTINE h5dread_char_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_2 + + SUBROUTINE h5dread_char_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_3 + + SUBROUTINE h5dread_char_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_4 + + SUBROUTINE h5dread_char_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_5 + + SUBROUTINE h5dread_char_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_6 + + SUBROUTINE h5dread_char_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dreadc_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dreadc_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_char_7 + + SUBROUTINE h5dread_real_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_scalar + + SUBROUTINE h5dread_real_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_1 + + SUBROUTINE h5dread_real_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_2 + + SUBROUTINE h5dread_real_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_3 + + SUBROUTINE h5dread_real_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_4 + + SUBROUTINE h5dread_real_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_5 + + SUBROUTINE h5dread_real_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_6 + + SUBROUTINE h5dread_real_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + REAL, INTENT(INOUT), DIMENSION(:,:,:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + INTEGER, EXTERNAL :: h5dread_c + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_real_7 + + SUBROUTINE h5dread_double_scalar(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_scalar + + SUBROUTINE h5dread_double_1(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_1 + + SUBROUTINE h5dread_double_2(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_2 + + SUBROUTINE h5dread_double_3(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_3 + + SUBROUTINE h5dread_double_4(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:,:,:) :: buf + ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_4 + + SUBROUTINE h5dread_double_5(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:,:,:,:) :: buf ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_5 + + SUBROUTINE h5dread_double_6(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:,:,:,:,:) :: buf + ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_6 + + SUBROUTINE h5dread_double_7(dset_id, mem_type_id, buf, hdferr, & + mem_space_id, file_space_id, xfer_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier + DOUBLE PRECISION, INTENT(INOUT), DIMENSION(:,:,:,:,:,:,:) :: buf + ! Data buffer + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: mem_space_id + ! Memory dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: file_space_id + ! File dataspace identfier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: xfer_prp + ! Transfer property list identifier + + INTEGER(HID_T) :: xfer_prp_default + INTEGER(HID_T) :: mem_space_id_default + INTEGER(HID_T) :: file_space_id_default + INTEGER, EXTERNAL :: h5dread_c + + xfer_prp_default = H5P_DEFAULT_F + mem_space_id_default = H5S_ALL_F + file_space_id_default = H5S_ALL_F + + if (present(xfer_prp)) xfer_prp_default = xfer_prp + if (present(mem_space_id)) mem_space_id_default = mem_space_id + if (present(file_space_id)) file_space_id_default = file_space_id + + hdferr = h5dread_c(dset_id, mem_type_id, mem_space_id_default, & + file_space_id_default, xfer_prp_default, buf) + + END SUBROUTINE h5dread_double_7 + + SUBROUTINE h5dget_space_f(dataset_id, dataspace_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier + INTEGER(HID_T), INTENT(OUT) :: dataspace_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5dget_space_c + hdferr = h5dget_space_c(dataset_id, dataspace_id) + END SUBROUTINE h5dget_space_f + + + SUBROUTINE h5dget_type_f(dataset_id, datatype_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier + INTEGER(HID_T), INTENT(OUT) :: datatype_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5dget_type_c + hdferr = h5dget_type_c (dataset_id, datatype_id) + END SUBROUTINE h5dget_type_f + + SUBROUTINE h5dextend_f(dataset_id, size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: size + ! Array containing + ! dimensions' sizes + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5dextend_c + hdferr = h5dextend_c(dataset_id, size) + END SUBROUTINE h5dextend_f + + + SUBROUTINE h5dget_create_plist_f(dataset_id, plist_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier + INTEGER(HID_T), INTENT(OUT) :: plist_id ! Dataset creation + ! property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5dget_create_plist_c + hdferr = h5dget_create_plist_c(dataset_id, plist_id) + END SUBROUTINE h5dget_create_plist_f + + END MODULE H5D diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c new file mode 100644 index 0000000..0ae4255 --- /dev/null +++ b/fortran/src/H5Ef.c @@ -0,0 +1,169 @@ +#include "H5f90.h" + + +/*---------------------------------------------------------------------------- + * Name: h5eclear_c + * Purpose: Call H5Eclear to clear the error stack for the current thread + * Inputs: + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5eclear_c( ) +{ + int ret_val = -1; + herr_t status; + + /* + * Call H5Eclear function. + */ + status = H5Eclear(); + if(status < 0) return ret_val; + ret_val = 0; + return ret_val; +} + +/*---------------------------------------------------------------------------- + * Name: h5eprint_c1 + * Purpose: Call H5Eprint to print the error stack in a default manner. + * Inputs: name - file name + * namelen - length of name + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5eprint_c1(_fcd name, int_f* namelen) +{ + int ret_val = -1; + herr_t status; + FILE * file; + char* c_name; + int c_namelen; + c_namelen = *namelen; + c_name = (char*)HD5f2cstring(name, c_namelen); + file = fopen(c_name, "w"); + + /* + * Call H5Eprint function. + */ + status = H5Eprint(file); + if(status < 0) return ret_val; + ret_val = 0; + return ret_val; +} + + +/*---------------------------------------------------------------------------- + * Name: h5eprint_c2 + * Purpose: Call H5Eprint to print the error stack to stderr + * in a default manner. + * Inputs: + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5eprint_c2() +{ + int ret_val = -1; + herr_t status; + + /* + * Call H5Eprint function. + */ + status = H5Eprint(NULL); + if(status < 0) return ret_val; + ret_val = 0; + return ret_val; +} + +/*---------------------------------------------------------------------------- + * Name: h5eget_major_c + * Purpose: Call H5Eget_major to get a character string + * describing an error specified by a major error number. + * Inputs: error_no - Major error number + * Outputs: name - character string describing the error + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5eget_major_c(int_f* error_no, _fcd name) +{ + int ret_val = -1; + const char* c_name; + H5E_major_t c_error_no; + c_error_no = (H5E_major_t)*error_no; + + /* + * Call H5Eget_major function. + */ + c_name = H5Eget_major(c_error_no); + HDpackFstring((char*)c_name, _fcdtocp(name), strlen(c_name)); + + if(!strcmp(c_name, "Invalid major error number")) return ret_val; + ret_val = 0; + return ret_val; +} + +/*---------------------------------------------------------------------------- + * Name: h5eget_minor_c + * Purpose: Call H5Eget_minor to get a character string + * describing an error specified by a minor error number. + * Inputs: error_no - Major error number + * Outputs: name - character string describing the error + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5eget_minor_c(int_f* error_no, _fcd name) +{ + int ret_val = -1; + const char* c_name; + H5E_minor_t c_error_no; + c_error_no = (H5E_minor_t)*error_no; + + /* + * Call H5Eget_minor function. + */ + c_name = H5Eget_minor(c_error_no); + HDpackFstring((char*)c_name, _fcdtocp(name), strlen(c_name)); + + if(!strcmp(c_name, "Invalid minor error number")) return ret_val; + ret_val = 0; + return ret_val; +} + +/*---------------------------------------------------------------------------- + * Name: h5eset_auto_c + * Purpose: Call H5Eset_auto to turn automatic error printing on or off. + * Inputs: printflag - flag to turn automatic error printing on or off. + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, March 29, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5eset_auto_c(int_f* printflag) +{ + int ret_val = -1; + herr_t status; + + if (*printflag == 1) + status = H5Eset_auto((H5E_auto_t)H5Eprint, stderr); + if (status >= 0) ret_val = 0; + return ret_val; +} diff --git a/fortran/src/H5Eff.f90 b/fortran/src/H5Eff.f90 new file mode 100644 index 0000000..a8393dd --- /dev/null +++ b/fortran/src/H5Eff.f90 @@ -0,0 +1,62 @@ +! +! This file contains FORTRAN90 interfaces for H5E functions +! + MODULE H5E + + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + SUBROUTINE h5eclear_f(hdferr) + IMPLICIT NONE + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5eclear_c + + hdferr = h5eclear_c() + END SUBROUTINE h5eclear_f + + SUBROUTINE h5eprint_f(hdferr, name) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: name ! File name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5eprint_c1, h5eprint_c2 + + INTEGER :: namelen + + namelen = LEN(NAME) + if (present(name)) hdferr = h5eprint_c1(name, namelen) + hdferr = h5eprint_c2() + END SUBROUTINE h5eprint_f + + SUBROUTINE h5eget_major_f(error_no, name, hdferr) + INTEGER, INTENT(IN) :: error_no !Major error number + CHARACTER(LEN=*), INTENT(OUT) :: name ! File name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5eget_major_c + + hdferr = h5eget_major_c(error_no, name) + END SUBROUTINE h5eget_major_f + + SUBROUTINE h5eget_minor_f(error_no, name, hdferr) + INTEGER, INTENT(IN) :: error_no !Major error number + CHARACTER(LEN=*), INTENT(OUT) :: name ! File name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5eget_minor_c + + hdferr = h5eget_minor_c(error_no, name) + END SUBROUTINE h5eget_minor_f + + SUBROUTINE h5eset_auto_f(printflag, hdferr) + INTEGER, INTENT(IN) :: printflag !flag to turn automatic error + !printing on or off + !possible values are: + !printon (1) + !printoff(0) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5eset_auto_c + + hdferr = h5eset_auto_c(printflag) + END SUBROUTINE h5eset_auto_f + + END MODULE H5E + diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c new file mode 100644 index 0000000..9e3d56d --- /dev/null +++ b/fortran/src/H5Ff.c @@ -0,0 +1,451 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5fcreate_c + * Purpose: Call H5Fcreate to create the file + * Inputs: name - name of the file + * namelen - name length + * access_flags - file access flags + * crt_pr - identifier of creation property list + * acc_prp - identifier of access property list + * Outputs: file_id - file identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Monday, July 26, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fcreate_c(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f* crt_prp, hid_t_f *acc_prp, hid_t_f *file_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_file_id; + unsigned c_access_flags; + hid_t c_crt_prp; + hid_t c_acc_prp; + int CASE; + hid_t CASE_prp; + + /* + * Define access flags + */ + CASE = (int)*access_flags; + switch (CASE) { + + case H5F_ACC_RDWR_F: + c_access_flags = H5F_ACC_RDWR; + break; + + case H5F_ACC_RDONLY_F: + c_access_flags = H5F_ACC_RDONLY; + break; + + case H5F_ACC_TRUNC_F: + c_access_flags = H5F_ACC_TRUNC; + break; + + case H5F_ACC_EXCL_F: + c_access_flags = H5F_ACC_EXCL; + break; + + case H5F_ACC_DEBUG_F: + c_access_flags = H5F_ACC_DEBUG; + break; + + default: + return ret_value; + } + + /* + * Define creation property + */ + c_crt_prp = *crt_prp; + if ( H5P_DEFAULT_F == c_crt_prp ) c_crt_prp = H5P_DEFAULT; + + /* + * Define access property + */ + c_acc_prp = *acc_prp; + if ( H5P_DEFAULT_F == c_acc_prp ) c_acc_prp = H5P_DEFAULT; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Fcreate function. + */ + c_file_id = H5Fcreate(c_name, c_access_flags, c_crt_prp, c_acc_prp); + + if (c_file_id < 0) return ret_value; + *file_id = c_file_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5fflush_c + * Purpose: Call H5Fflush to flush the object + * Inputs: object_id - identifier of either a file, a dataset, + * a group, an attribute or a named data type + * scope - integer to specify the flushing action, either + * H5F_SCOPE_GLOBAL or H5F_SCOPE_LOCAL + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, November 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fflush_c (hid_t_f *object_id, int_f *scope) +{ + int ret_value = -1; + hid_t c_file_id; + int CASE; + H5F_scope_t c_scope; + htri_t status; + + /* + * Define scope flags + */ + CASE = (int)*scope; + switch (CASE) { + + case H5F_SCOPE_LOCAL_F: + c_scope = H5F_SCOPE_LOCAL; + break; + + case H5F_SCOPE_GLOBAL_F: + c_scope = H5F_SCOPE_GLOBAL; + break; + + default: + return ret_value; + } + + /* + * Call H5Fflush function. + */ + + c_file_id = *object_id; + + status = H5Fflush(c_file_id, c_scope); + + if (status >= 0) ret_value = 0; + + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5fmount_c + * Purpose: Call H5Fmount to mount the file + * Inputs: loc_id - Identifier for file or group + * dsetname - name of dataset + * namelen - dsetname length + * file_id - file identifier for the file to be mounted + * acc_prp - identifier of access property list + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Monday, October 25, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen, hid_t_f *file_id, hid_t_f *acc_prp) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_loc_id; + hid_t c_file_id; + hid_t c_acc_prp; + htri_t status; + + /* + * Define access property + */ + c_acc_prp = *acc_prp; + if ( H5P_DEFAULT_F == c_acc_prp ) c_acc_prp = H5P_DEFAULT; + + c_loc_id = *loc_id; + c_file_id = *file_id; + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(dsetname, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Fmount function. + */ + status = H5Fmount(c_loc_id, c_name, c_file_id, c_acc_prp); + + if (status >= 0) ret_value = 0; + + HDfree(c_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5funmount_c + * Purpose: Call H5Funmount to unmount the file + * Inputs: loc_id - Identifier for file or group + * dsetname - name of dataset + * namelen - dsetname length + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Monday, October 25, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5funmount_c (hid_t_f *loc_id, _fcd dsetname, int_f *namelen) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_loc_id; + htri_t status; + + c_loc_id = *loc_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(dsetname, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Fmount function. + */ + status = H5Funmount(c_loc_id, c_name); + + if (status >= 0) ret_value = 0; + + HDfree(c_name); + return ret_value; +} + + + +/*---------------------------------------------------------------------------- + * Name: h5fopen_c + * Purpose: Call H5Fopen to open the file + * Inputs: name - name of the file + * namelen - name length + * access_flags - file access flags + * acc_prp - identifier of access property list + * Outputs: file_id - file identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fopen_c (_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hid_t_f *file_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_file_id; + unsigned c_access_flags; + hid_t c_acc_prp; + int CASE; + hid_t CASE_prp; + + /* + * Define access flags + */ + CASE = (int)*access_flags; + switch (CASE) { + + case H5F_ACC_RDWR_F: + c_access_flags = H5F_ACC_RDWR; + break; + + case H5F_ACC_RDONLY_F: + c_access_flags = H5F_ACC_RDONLY; + break; + + case H5F_ACC_TRUNC_F: + c_access_flags = H5F_ACC_TRUNC; + break; + + case H5F_ACC_EXCL_F: + c_access_flags = H5F_ACC_EXCL; + break; + + case H5F_ACC_DEBUG_F: + c_access_flags = H5F_ACC_DEBUG; + break; + + default: + return ret_value; + } + + /* + * Define access property + */ + c_acc_prp = *acc_prp; + if ( H5P_DEFAULT_F == c_acc_prp ) c_acc_prp = H5P_DEFAULT; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Fopen function. + */ + c_file_id = H5Fopen(c_name, c_access_flags, c_acc_prp); + + if (c_file_id < 0) return ret_value; + *file_id = (hid_t_f)c_file_id; + + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5freopen_c + * Purpose: Call H5Freopen to open the file + * Inputs: file_id1 - file identifier + * Outputs: file_id2 - file identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, November 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2) +{ + int ret_value = -1; + hid_t c_file_id1, c_file_id2; + + c_file_id1 = *file_id1; + c_file_id2 = H5Freopen(c_file_id1); + + if (c_file_id2 < 0) return ret_value; + *file_id2 = (hid_t_f)c_file_id2; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5fget_create_plist_c + * Purpose: Call H5Fget_create_plist to get the file creation property list + * Inputs: file_id - file identifier + * Outputs: prop_id - creation property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, November 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id) +{ + int ret_value = -1; + hid_t c_file_id, c_prop_id; + + c_file_id = *file_id; + c_prop_id = H5Fget_create_plist(c_file_id); + + if (c_prop_id < 0) return ret_value; + *prop_id = (hid_t_f)c_prop_id; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5fget_access_plist_c + * Purpose: Call H5Fget_access_plist to get the file access property list + * Inputs: file_id - file identifier + * Outputs: access_id - access property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, November 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id) +{ + int ret_value = -1; + hid_t c_file_id, c_access_id; + + c_file_id = *file_id; + c_access_id = H5Fget_access_plist(c_file_id); + + if (c_access_id < 0) return ret_value; + *access_id = (hid_t_f)c_access_id; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5fis_hdf5_c + * Purpose: Call H5Fis_hdf5 to determone if the file is an HDF5 file + * Inputs: name - name of the file + * namelen - name length + * Outputs: flag - 0 if file is not HDF5 file , positive if a file + * is an HDF5 file, and negative on failure. + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5fis_hdf5_c (_fcd name, int_f *namelen, int_f *flag) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + htri_t status; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Fopen function. + */ + status = H5Fis_hdf5(c_name); + *flag = (int_f)status; + if (status >= 0) ret_value = 0; + + HDfree(c_name); + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5fclose_c + * Purpose: Call H5Fclose to close the file + * Inputs: file_id - identifier of the file to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Monday, July 26, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5fclose_c ( hid_t_f *file_id ) +{ + int ret_value = 0; + hid_t c_file_id; + + c_file_id = *file_id; + if ( H5Fclose(c_file_id) < 0 ) ret_value = -1; + return ret_value; +} diff --git a/fortran/src/H5Fff.f90 b/fortran/src/H5Fff.f90 new file mode 100644 index 0000000..817978b --- /dev/null +++ b/fortran/src/H5Fff.f90 @@ -0,0 +1,199 @@ +! +! This file contains Fortran90 interfaces for H5F functions. +! + MODULE H5F + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + SUBROUTINE h5fcreate_f(name, access_flags, file_id, hdferr, & + creation_prp, access_prp) + + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the file + INTEGER, INTENT(IN) :: access_flags ! File access flags + INTEGER(HID_T), INTENT(OUT) :: file_id ! File identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: creation_prp + ! File creation propertly + ! list identifier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + ! File access property list + ! identifier + INTEGER :: creation_prp_default + INTEGER :: access_prp_default + INTEGER :: namelen ! Length of the name character string + INTEGER, EXTERNAL :: h5fcreate_c + + creation_prp_default = H5P_DEFAULT_F + access_prp_default = H5P_DEFAULT_F + + if (present(creation_prp)) creation_prp_default = creation_prp + if (present(access_prp)) access_prp_default = access_prp + namelen = LEN(name) + hdferr = h5fcreate_c(name, namelen, access_flags, & + creation_prp_default, access_prp_default, file_id) + + END SUBROUTINE h5fcreate_f + + SUBROUTINE h5fflush_f(object_id, scope, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: object_id !identifier for any object + !associate with a file, + !including the file itself, + !a dataset, a group, an + !attribute, or a named + !data type + + INTEGER, INTENT(IN) :: scope !scope of the flushing + !action, possible values + !are: H5F_SCOPE_GLOBAL_F + ! which flushes the entire + !virtual file, + !and H5F_SCOPE_LOCAL_F + !which flushes only the + !specified file. + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5fflush_c + + hdferr = h5fflush_c(object_id, scope) + + END SUBROUTINE h5fflush_f + + + SUBROUTINE h5fmount_f(loc_id, dsetname, file_id, hdferr, access_prp) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for file or group + ! in which dsetname is defined + CHARACTER(LEN=*), INTENT(IN) :: dsetname ! Name of the dataset + INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier for the + ! file to be mounted + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + ! File access property list + ! identifier + INTEGER :: access_prp_default + INTEGER :: namelen ! Length of the dsetname character string + INTEGER, EXTERNAL :: h5fmount_c + + access_prp_default = H5P_DEFAULT_F + if (present(access_prp)) access_prp_default = access_prp + namelen = LEN(dsetname) + hdferr = h5fmount_c(loc_id, dsetname, namelen, file_id, access_prp_default) + + END SUBROUTINE h5fmount_f + + + SUBROUTINE h5funmount_f(loc_id, dsetname, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for file or group + ! in which dsetname is defined + CHARACTER(LEN=*), INTENT(IN) :: dsetname ! Name of the dataset + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen ! Length of the dsetname character string + INTEGER, EXTERNAL :: h5funmount_c + + namelen = LEN(dsetname) + hdferr = h5funmount_c(loc_id, dsetname, namelen) + + END SUBROUTINE h5funmount_f + + SUBROUTINE h5fopen_f(name, access_flags, file_id, hdferr, & + access_prp) + + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the file + INTEGER, INTENT(IN) :: access_flags ! File access flags + INTEGER(HID_T), INTENT(OUT) :: file_id ! File identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp + ! File access property list + ! identifier + INTEGER :: access_prp_default + INTEGER :: namelen ! Length of the name character string + INTEGER, EXTERNAL :: h5fopen_c + + access_prp_default = H5P_DEFAULT_F + if (present(access_prp)) access_prp_default = access_prp + namelen = LEN(name) + hdferr = h5fopen_c(name, namelen, access_flags, & + access_prp_default, file_id) + + END SUBROUTINE h5fopen_f + + SUBROUTINE h5freopen_f(file_id, ret_file_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier + INTEGER(HID_T), INTENT(OUT) :: ret_file_id ! New File identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5freopen_c + + hdferr = h5freopen_c(file_id, ret_file_id) + + END SUBROUTINE h5freopen_f + + SUBROUTINE h5fget_create_plist_f(file_id, prop_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier + INTEGER(HID_T), INTENT(OUT) :: prop_id ! File creation property + ! list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5fget_create_plist_c + + hdferr = h5fget_create_plist_c(file_id, prop_id) + + END SUBROUTINE h5fget_create_plist_f + + SUBROUTINE h5fget_access_plist_f(file_id, access_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier + INTEGER(HID_T), INTENT(OUT) :: access_id ! File access property + ! list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5fget_access_plist_c + + hdferr = h5fget_access_plist_c(file_id, access_id) + + END SUBROUTINE h5fget_access_plist_f + + + SUBROUTINE h5fis_hdf5_f(name, status, hdferr) + + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the file + LOGICAL, INTENT(OUT) :: status ! Indicates if file + ! is an HDF5 file + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen ! Length of the name character string + INTEGER :: flag ! "TRUE/FALSE" flag from C routine + ! to define status value. + INTEGER, EXTERNAL :: h5fis_hdf5_c + + namelen = LEN(name) + hdferr = h5fis_hdf5_c(name, namelen, flag) + status = .TRUE. + if (flag .EQ. 0) status = .FALSE. + + END SUBROUTINE h5fis_hdf5_f + + SUBROUTINE h5fclose_f(file_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5fclose_c + + hdferr = h5fclose_c(file_id) + + END SUBROUTINE h5fclose_f + + END MODULE H5F diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c new file mode 100644 index 0000000..110db73 --- /dev/null +++ b/fortran/src/H5Gf.c @@ -0,0 +1,536 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5gcreate_c + * Purpose: Call H5Gcreate to create a group + * Inputs: loc_id - file or group identifier + * name - name of the group + * namelen - name length + * size_hint - length of names in the group + * Outputs: grp_id - group identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, hid_t_f *grp_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + size_t c_size_hint; + hid_t c_grp_id; + hid_t c_loc_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + /* + * Call H5Gcreate function. + */ + c_loc_id = *loc_id; + if ( *size_hint == OBJECT_NAMELEN_DEFAULT_F ) + c_grp_id = H5Gcreate(c_loc_id, c_name, NULL); + else { + c_size_hint = *size_hint; + c_grp_id = H5Gcreate(c_loc_id, c_name, c_size_hint); + } + if (c_grp_id < 0) return ret_value; + *grp_id = (hid_t_f)c_grp_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5gopen_c + * Purpose: Call H5Gopen to open a dataset + * Inputs: loc_id - file or group identifier + * name - name of the group + * namelen - name length + * Outputs: grp_id - group identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_grp_id; + hid_t c_loc_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Gopen function. + */ + c_loc_id = *loc_id; + c_grp_id = H5Gopen(c_loc_id, c_name); + + HDfree(c_name); + if (c_grp_id < 0) return ret_value; + *grp_id = (hid_t_f)c_grp_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5gget_obj_info_idx_c + * Purpose: Call H5Gget_obj_info to return name and the type of group + * member + * Inputs: loc_id - file or group identifier + * name - name of the group + * namelen - name length + * idx - index of the group member + * Outputs: obj_name - buffer to store member's name + * obj_namelen - length of the buffer + * obj_type - type of the object + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gget_obj_info_idx_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *idx, _fcd obj_name, int_f *obj_namelen, int_f *obj_type) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name; + int c_namelen; + int c_obj_namelen; + char *c_obj_name = NULL; + int type; + int c_idx; + herr_t c_ret_value; + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Allocate buffer to hold name of the object + */ + if (*obj_namelen) c_obj_name = (char *)HDmalloc(*obj_namelen + 1); + if (c_obj_name == NULL) return ret_value; + /* + * Call H5Gget_obj_info_idx function. + */ + c_loc_id = *loc_id; + c_idx = *idx; + c_ret_value = H5Gget_obj_info_idx(c_loc_id, c_name, c_idx, &c_obj_name, &type); + + if (c_ret_value < 0) { + HDfree(c_obj_name); + return ret_value; + } + switch (type) { + case H5G_LINK: + *obj_type = H5G_LINK_F; + break; + + case H5G_GROUP: + *obj_type = H5G_GROUP_F; + break; + + case H5G_DATASET: + *obj_type = H5G_DATASET_F; + break; + + case H5G_TYPE: + *obj_type = H5G_TYPE_F; + break; + default: + return ret_value; + } + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + c_obj_namelen = *obj_namelen; + HDpackFstring(c_obj_name, _fcdtocp(obj_name), c_obj_namelen); + if (c_obj_name) HDfree(c_obj_name); + if (c_name) HDfree(c_name); + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5gn_members_c + * Purpose: Call H5Gn_members to find number of objects in the group + * Inputs: loc_id - file or group identifier + * name - name of the group + * namelen - name length + * Outputs: nmemebers - number of members + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gn_members_c (hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *nmembers) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name; + int c_namelen; + int c_nmembers; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Gn_members function. + */ + c_loc_id = *loc_id; + c_nmembers = H5Gn_members(c_loc_id, c_name); + + HDfree(c_name); + if (c_nmembers < 0) return ret_value; + *nmembers = (int_f)c_nmembers; + ret_value = 0; + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5gclose_c + * Purpose: Call H5Gclose to close the group + * Inputs: grp_id - identifier of the group to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 5, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5gclose_c ( hid_t_f *grp_id ) +{ + int ret_value = 0; + hid_t c_grp_id; + + c_grp_id = *grp_id; + if ( H5Gclose(c_grp_id) < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5glink_c + * Purpose: Call H5Glink to link the specified type + * Inputs: loc_id - identifier of file or group + * link_type - link type + * current_name - name of the existing object for hard link, + * anything for the soft link + * current_namelen - current name lenghth + * new_name - new name for the object + * new_namelen - new_name lenghth + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5glink_c(hid_t_f *loc_id, int_f *link_type, _fcd current_name, int_f *current_namelen, _fcd new_name, int_f *new_namelen) +{ + int ret_value = -1; + hid_t c_loc_id; + H5G_link_t c_link_type; + char *c_current_name, *c_new_name; + int c_current_namelen, c_new_namelen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_current_namelen =*current_namelen; + c_new_namelen =*new_namelen; + c_current_name = (char *)HD5f2cstring(current_name, c_current_namelen); + c_new_name = (char *)HD5f2cstring(new_name, c_new_namelen); + if((c_current_name == NULL)||(c_new_name == NULL)) + return ret_value; + /* + * Call H5Glink function + */ + c_loc_id = *loc_id; + c_link_type = (H5G_link_t)*link_type; + c_ret_value = H5Glink(c_loc_id, c_link_type, c_current_name, c_new_name); + if(c_current_name) HDfree(c_current_name); + if(c_new_name) HDfree(c_new_name); + if(c_ret_value < 0) return ret_value; + + ret_value = 0; + return ret_value ; +} + +/*---------------------------------------------------------------------------- + * Name: h5gunlink_c + * Purpose: Call H5Gunlink to remove the specified name + * Inputs: loc_id - identifier of file or group + * name - name of the object to unlink + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5gunlink_c(hid_t_f *loc_id, _fcd name, int_f *namelen) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name; + int c_namelen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if(c_name == NULL) return ret_value; + /* + * Call H5Gunlink function + */ + c_loc_id = *loc_id; + c_ret_value = H5Gunlink(c_loc_id, c_name); + if(c_name) HDfree(c_name); + if(c_ret_value < 0) return ret_value; + ret_value = 0; + return ret_value ; +} + +/*---------------------------------------------------------------------------- + * Name: h5gmove_c + * Purpose: Call H5Gmove to rename an object within an HDF5 file + * Inputs: loc_id - identifier of file or group + * src_name - name of the original object + * src_namelen - original name lenghth + * dst_name - new name for the object + * dst_namelen - new name lenghth + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5gmove_c(hid_t_f *loc_id, _fcd src_name, int_f *src_namelen, _fcd dst_name, int_f*dst_namelen) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_src_name, *c_dst_name; + int c_src_namelen, c_dst_namelen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_src_namelen = *src_namelen; + c_dst_namelen = *dst_namelen; + c_src_name = (char *)HD5f2cstring(src_name, c_src_namelen); + c_dst_name = (char *)HD5f2cstring(dst_name, c_dst_namelen); + if((c_src_name == NULL)||(c_dst_name == NULL)) + return ret_value; + /* + * Call H5Gmove function + */ + c_loc_id = *loc_id; + c_ret_value = H5Gmove(c_loc_id, c_src_name, c_dst_name); + if(c_src_name) HDfree(c_src_name); + if(c_dst_name) HDfree(c_dst_name); + if(c_ret_value < 0) return ret_value; + + ret_value = 0; + return ret_value ; +} + +/*---------------------------------------------------------------------------- + * Name: h5gget_linkval_c + * Purpose: Call H5Gget_linkval to return the name of object + * Inputs: loc_id - identifier of file or group + * name - name of the object that symbolic link points to + * namelen - the name lenghth + * size - lenghth of retrurned value + * Outputs: value - name to be returned + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5gget_linkval_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size, _fcd value ) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name; + int c_namelen; + char *c_value = NULL; + size_t c_size; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if(c_name == NULL) return ret_value; + + /* + * Allocate buffer to hold name of the value + */ + if(*size) c_value = (char *)HDmalloc(*size); + if(c_value == NULL) { + HDfree(c_name); + return ret_value; + } + + /* + * Call H5Gget_linkval function + */ + + c_size = (size_t)*size; + c_loc_id = *loc_id; + c_ret_value = H5Gget_linkval(c_loc_id, c_name, c_size, c_value); + if(c_ret_value < 0) { + if(c_value) HDfree(c_value); + if(c_name) HDfree(c_name); + return ret_value; + } + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HDpackFstring(c_value, _fcdtocp(value), (int)*size); + + if(c_value) HDfree(c_value); + if(c_name) HDfree(c_name); + + ret_value = 0; + return ret_value ; +} + +/*---------------------------------------------------------------------------- + * Name: h5gset_comment_c + * Purpose: Call H5Gset_comment to set comments for the specified object + * Inputs: loc_id - identifier of file or group + * name - name of object whose comment is to be set or reset + * namelen - the name lenghth + * comment - the new comment + * commentlen - new comment lenghth + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5gset_comment_c(hid_t_f *loc_id, _fcd name, int_f *namelen, _fcd comment, int_f*commentlen) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name, *c_comment; + int c_namelen, c_commentlen; + herr_t c_ret_value; + /* + * Convert Fortran name to C name + */ + c_namelen = *namelen; + c_commentlen =*commentlen; + c_name = (char *)HD5f2cstring(name, c_namelen); + c_comment = (char *)HD5f2cstring(comment, c_commentlen); + if((c_name == NULL)||(c_comment == NULL)) + return ret_value; + /* + * Call H5Gset_comment function + */ + c_loc_id = *loc_id; + c_ret_value = H5Gset_comment(c_loc_id, c_name, c_comment); + if(c_name) HDfree(c_name); + if(c_comment) HDfree(c_comment); + if(c_ret_value < 0) return ret_value; + + ret_value = 0; + return ret_value ; +} + + +/*---------------------------------------------------------------------------- + * Name: h5gget_comment_c + * Purpose: Call H5Gget_comment to retrieve comments for the specified object + * Inputs: loc_id - identifier of file or group + * name - name of object whose comment is to be set or reset + * namelen - the name lenghth + * bufsize - at most bufsize characters + * comment - the new comment + * Returns: 0 on success, -1 on failure + * Programmer: Mingshi Chen + * Friday, August 6, 1999 + * Modifications: Elena Pourmal + *---------------------------------------------------------------------------*/ + +int_f +nh5gget_comment_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *bufsize, _fcd comment) +{ + int ret_value = -1; + hid_t c_loc_id; + char *c_name; + int c_namelen; + char *c_comment = NULL; + size_t c_bufsize; + herr_t c_ret_value; + + /* + * Convert Fortran name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if(c_name == NULL) return ret_value; + + /* + * Allocate buffer to hold the comment + */ + c_bufsize = (size_t)*bufsize; + if(c_bufsize) c_comment = (char *)malloc(c_bufsize); + if(c_comment == NULL) { + HDfree(c_name); + return ret_value; + } + + /* + * Call H5Gget_comment function + */ + c_loc_id = *loc_id; + c_ret_value = H5Gget_comment(c_loc_id, c_name, c_bufsize, c_comment); + if(c_ret_value < 0) { + HDfree(c_name); + HDfree(c_comment); + return ret_value; + } + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HDpackFstring(c_comment, _fcdtocp(comment), (int)*bufsize); + + if(c_name) HDfree(c_name); + if(c_comment) HDfree(c_comment); + + ret_value = 0; + return ret_value ; +} diff --git a/fortran/src/H5Gff.f90 b/fortran/src/H5Gff.f90 new file mode 100644 index 0000000..de6a8f0 --- /dev/null +++ b/fortran/src/H5Gff.f90 @@ -0,0 +1,234 @@ +! +! This file contains Fortran90 interfaces for H5F functions. +! + MODULE H5G + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + !!!============================================================ + + SUBROUTINE h5gcreate_f(loc_id, name, grp_id, hdferr, size_hint) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group + INTEGER(HID_T), INTENT(OUT) :: grp_id ! Group identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(SIZE_T), OPTIONAL, INTENT(IN) :: size_hint + ! Parameter indicating + ! the number of bytes + ! to reserve for the + ! names that will appear + ! in the group + INTEGER :: namelen ! Length of the name character string + INTEGER(SIZE_T) :: size_hint_default + INTEGER, EXTERNAL :: h5gcreate_c + size_hint_default = OBJECT_NAMELEN_DEFAULT_F + if (present(size_hint)) size_hint_default = size_hint + namelen = LEN(name) + hdferr = h5gcreate_c(loc_id, name, namelen, size_hint_default, & + grp_id) + + END SUBROUTINE h5gcreate_f + + !!!============================================================ + + SUBROUTINE h5gopen_f(loc_id, name, grp_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group + INTEGER(HID_T), INTENT(OUT) :: grp_id ! File identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Length of the name character string + INTEGER, EXTERNAL :: h5gopen_c + + namelen = LEN(name) + hdferr = h5gopen_c(loc_id, name, namelen, grp_id) + + END SUBROUTINE h5gopen_f + + !!!============================================================ + + SUBROUTINE h5gclose_f(grp_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: grp_id ! Group identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5gclose_c + + hdferr = h5gclose_c(grp_id) + + END SUBROUTINE h5gclose_f + + !!!============================================================ + + SUBROUTINE h5gget_obj_info_idx_f(loc_id, name, idx, & + obj_name, obj_type, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group + INTEGER, INTENT(IN) :: idx ! Index of member object + CHARACTER(LEN=*), INTENT(OUT) :: obj_name ! Name of the object + INTEGER, INTENT(OUT) :: obj_type ! Object type + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Length of the name character string + INTEGER :: obj_namelen ! Length of the obj_name character string + INTEGER, EXTERNAL :: h5gget_obj_info_idx_c + + namelen = LEN(name) + obj_namelen = LEN(obj_name) + hdferr = h5gget_obj_info_idx_c(loc_id, name, namelen, idx, & + obj_name, obj_namelen, obj_type) + + END SUBROUTINE h5gget_obj_info_idx_f + + !!!============================================================ + + SUBROUTINE h5gn_members_f(loc_id, name, nmembers, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group + INTEGER, INTENT(OUT) :: nmembers ! Number of members in the + ! group + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Length of the name character string + INTEGER, EXTERNAL :: h5gn_members_c + + namelen = LEN(name) + hdferr = h5gn_members_c(loc_id, name, namelen, nmembers) + + END SUBROUTINE h5gn_members_f + + !!!============================================================ + + SUBROUTINE h5glink_f(loc_id, link_type, current_name, & + new_name, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + INTEGER, INTENT(IN) :: link_type ! link type + ! Possible values are: + ! H5G_LINK_HARD_F (0) or + ! H5G_LINK_SOFT_F (1) + + CHARACTER(LEN=*), INTENT(IN) :: current_name + ! Current name of an object + CHARACTER(LEN=*), INTENT(IN) :: new_name ! New name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: current_namelen ! Lenghth of the current_name string + INTEGER :: new_namelen ! Lenghth of the new_name string + INTEGER, EXTERNAL :: h5glink_c + + current_namelen = LEN(current_name) + new_namelen = LEN(new_name) + hdferr = h5glink_c(loc_id, link_type, current_name, & + current_namelen, new_name, new_namelen) + END SUBROUTINE h5glink_f + + !!!============================================================ + + SUBROUTINE h5gunlink_f(loc_id, name, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Lenghth of the name character string + + INTEGER, EXTERNAL :: h5gunlink_c + + namelen = LEN(name) + hdferr = h5gunlink_c(loc_id, name, namelen) + END SUBROUTINE h5gunlink_f + + !!!============================================================ + + SUBROUTINE h5gmove_f(loc_id, name, new_name, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Current name of an object + CHARACTER(LEN=*), INTENT(IN) :: new_name ! New name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Lenghth of the current_name string + INTEGER :: new_namelen ! Lenghth of the new_name string + INTEGER, EXTERNAL :: h5gmove_c + + namelen = LEN(name) + new_namelen = LEN(new_name) + hdferr = h5gmove_c(loc_id, name, namelen, new_name, new_namelen) + END SUBROUTINE h5gmove_f + + !!!============================================================ + + SUBROUTINE h5gget_linkval_f(loc_id, name, size, buffer, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Current name of an object + INTEGER(SIZE_T), INTENT(IN) :: size ! Maximum number of buffer + CHARACTER(LEN=size), INTENT(OUT) :: buffer + ! Buffer to hold a name of + ! the object symbolic link + ! points to + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Lenghth of the current_name string + INTEGER, EXTERNAL :: h5gget_linkval_c + + namelen = LEN(name) + hdferr = h5gget_linkval_c(loc_id, name, namelen, size, buffer) + END SUBROUTINE h5gget_linkval_f + + !!!============================================================ + + SUBROUTINE h5gset_comment_f(loc_id, name, comment, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Current name of an object + CHARACTER(LEN=*), INTENT(IN) :: comment ! New name of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Lenghth of the current_name string + INTEGER :: commentlen ! Lenghth of the comment string + INTEGER, EXTERNAL :: h5gset_comment_c + + namelen = LEN(name) + commentlen = LEN(comment) + hdferr = h5gset_comment_c(loc_id, name, namelen, comment, commentlen) + END SUBROUTINE h5gset_comment_f + + !!!============================================================ + + SUBROUTINE h5gget_comment_f(loc_id, name, size, buffer, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Current name of an object + INTEGER(SIZE_T), INTENT(IN) :: size ! Maximum number of buffer + CHARACTER(LEN=size), INTENT(OUT) :: buffer + ! Buffer to hold a comment + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Lenghth of the current_name string + INTEGER, EXTERNAL :: h5gget_comment_c + + namelen = LEN(name) + hdferr = h5gget_comment_c(loc_id, name, namelen, size, buffer) + END SUBROUTINE h5gget_comment_f + + !!!============================================================ + + END MODULE H5G diff --git a/fortran/src/H5Git.c b/fortran/src/H5Git.c new file mode 100644 index 0000000..51db86f --- /dev/null +++ b/fortran/src/H5Git.c @@ -0,0 +1,220 @@ +/*------------------------------------------------------------------------- + * Copyright (C) 1999 National Center for Supercomputing Applications. + * All rights reserved. + * + *------------------------------------------------------------------------- + */ + +#include <hdf5.h> +#include "H5Git.h" +#define FALSE 0 + +herr_t count_elems(hid_t loc_id, const char *name, void *opdata); +/*herr_t obj_info(hid_t loc_id, const char *name, void *opdata);*/ +herr_t obj_info(hid_t loc_id, char *name, void *opdata); + +typedef struct retval { + char * name; + int type; +} retval_t; + + +/*------------------------------------------------------------------------- + * Function: H5Gn_members + * + * Purpose: Return the number of members of a group. The "members" + * are the datasets, groups, and named datatypes in the + * group. + * + * This function wraps the H5Ginterate() function in + * a completely obvious way, uses the operator + * function 'count_members()' below; + * + * See also: H5Giterate() + * + * IN: hid_t file: the file id + * IN: char *group_name: the name of the group + * + * Errors: + * + * Return: Success: The object number of members of + * the group. + * + * Failure: FAIL + * + * Programmer: REMcG + * Monday, Aug 2, 1999 + * + * Modifications: + * + *------------------------------------------------------------------------- + */ +int +H5Gn_members( hid_t loc_id, char *group_name ) +{ + int res; + int nelems = 0; + + res = H5Giterate(loc_id, group_name, NULL, count_elems, (void *)&nelems); + if (res < 0) { + return res; + } else { + return( nelems ); + } +} + + + +/*------------------------------------------------------------------------- + * Function: H5Gget_obj_info_idx + * + * Purpose: Return the name and type of the member of the group + * at index 'idx', as defined by the H5Giterator() + * function. + * + * This function wraps the H5Ginterate() function in + * a completely obvious way, uses the operator + * function 'get_objinfo()' below; + * + * See also: H5Giterate() + * + * IN: hid_t file: the file id + * IN: char *group_name: the name of the group + * IN: int idx: the index of the member object (see + * H5Giterate() + * OUT: char **objname: the name of the member object + * OUT: int *type: the type of the object (dataset, + * group, or named datatype) + * + * Errors: + * + * Return: Success: The object number of members of + * the group. + * + * Failure: FAIL + * + * Programmer: REMcG + * Monday, Aug 2, 1999 + * + * Modifications: + * + *------------------------------------------------------------------------- + */ +herr_t +H5Gget_obj_info_idx( hid_t loc_id, char *group_name, int idx, char **objname, int *type ) +{ + int res; + retval_t retVal; + + res = H5Giterate(loc_id, group_name, &idx, obj_info, (void *)&retVal); + if (res < 0) { + return res; + } + *objname = retVal.name; + *type = retVal.type; + return 0; +} + + + +/*------------------------------------------------------------------------- + * Function: count_elems + * + * Purpose: this is the operator function called by H5Gn_members(). + * + * This function is passed to H5Ginterate(). + * + * See also: H5Giterate() + * + * OUT: 'opdata' is returned as an integer with the + * number of members in the group. + * + * Errors: + * + * Return: Success: The object number of members of + * the group. + * + * Failure: FAIL + * + * Programmer: REMcG + * Monday, Aug 2, 1999 + * + * Modifications: + * + *------------------------------------------------------------------------- + */ + +static herr_t +count_elems(hid_t loc_id, const char *name, void *opdata) +{ + herr_t res; + H5G_stat_t statbuf; + + res = H5Gget_objinfo(loc_id, name, FALSE, &statbuf); + if (res < 0) { + return 1; + } + switch (statbuf.type) { + case H5G_GROUP: + (*(int *)opdata)++; + break; + case H5G_DATASET: + (*(int *)opdata)++; + break; + case H5G_TYPE: + (*(int *)opdata)++; + break; + default: + (*(int *)opdata)++; /* ???? count links or no? */ + break; + } + return 0; + } + + +/*------------------------------------------------------------------------- + * Function: obj_info + * + * Purpose: this is the operator function called by H5Gn_members(). + * + * This function is passed to H5Ginterate(). + * + * See also: H5Giterate() + * + * OUT: 'opdata' is returned as a 'recvar_t', containing + * the object name and type. + * + * Errors: + * + * Return: Success: The object number of members of + * the group. + * + * Failure: FAIL + * + * Programmer: REMcG + * Monday, Aug 2, 1999 + * + * Modifications: + * + *------------------------------------------------------------------------- + * group, or named datatype) + */ +static herr_t +/*obj_info(hid_t loc_id, const char *name, void *opdata)*/ +obj_info(hid_t loc_id, char *name, void *opdata) +{ + herr_t res; + H5G_stat_t statbuf; + + res = H5Gget_objinfo(loc_id, name, FALSE, &statbuf); + if (res < 0) { + ((retval_t *)opdata)->type = 0; + ((retval_t *)opdata)->name = NULL; + return 1; + } else { + ((retval_t *)opdata)->type = statbuf.type; +/* ((retval_t *)opdata)->name = strdup(name); */ + ((retval_t *)opdata)->name = name; + return 1; + } + } diff --git a/fortran/src/H5Git.h b/fortran/src/H5Git.h new file mode 100644 index 0000000..e243a18 --- /dev/null +++ b/fortran/src/H5Git.h @@ -0,0 +1,16 @@ +/*------------------------------------------------------------------------- + * Copyright (C) 1997 National Center for Supercomputing Applications. + * All rights reserved. + * + *------------------------------------------------------------------------- + */ +#ifndef _H5Git_H +#define _H5Git_H + +#include <hdf5.h> + +int H5Gn_members( hid_t loc_id, char *group_name ); + +herr_t H5Gget_obj_info_idx( hid_t loc_id, char *group_name, int idx, char **objname, int *type ); + +#endif /*_H5Git_H*/ diff --git a/fortran/src/H5If.c b/fortran/src/H5If.c new file mode 100644 index 0000000..f17dc01 --- /dev/null +++ b/fortran/src/H5If.c @@ -0,0 +1,29 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5iget_type_c + * Purpose: Call H5Iget_type to get the type of an object + * Inputs: obj_id - object identifier + * Outputs: type - object type + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Thursday, March 24, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5iget_type_c (hid_t_f *obj_id, int_f *type) +{ + int ret_value = -1; + hid_t c_obj_id; + H5I_type_t c_type; + + /* + * Call H5Iget_type function. + */ + c_obj_id = *obj_id; + c_type = H5Iget_type(c_obj_id); + if (c_type == H5I_BADID) return ret_value; + *type = (int_f)c_type; + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Iff.f90 b/fortran/src/H5Iff.f90 new file mode 100644 index 0000000..cd50da3 --- /dev/null +++ b/fortran/src/H5Iff.f90 @@ -0,0 +1,33 @@ +! +! This file contains FORTRAN90 interfaces for H5I functions +! + MODULE H5I + + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + SUBROUTINE h5iget_type_f(obj_id, type, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id !Object identifier + INTEGER, INTENT(OUT) :: type !type of an object. + !possible values are: + !H5I_FILE_F(1) + !H5I_GROUP_F(2) + !H5I_DATATYPE_F(3) + !H5I_DATASPACE_F(4) + !H5I_DATASET_F(5) + !H5I_ATTR_F(6) + !H5I_BADID_F(-1) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5iget_type_c + hdferr = h5iget_type_c(obj_id, type) + END SUBROUTINE h5iget_type_f + + END MODULE H5I + + + + + diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c new file mode 100644 index 0000000..038e083 --- /dev/null +++ b/fortran/src/H5Pf.c @@ -0,0 +1,1748 @@ +#include "H5f90.h" + + +/*---------------------------------------------------------------------------- + * Name: h5pcreate_c + * Purpose: Call H5Pcreate to create a property list + * Inputs: classtype - type of the property list + * Outputs: prp_id - identifier of the created property list + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pcreate_c ( int_f *classtype, hid_t_f *prp_id ) +{ + H5P_class_t c_classtype; + int CASE; + int ret_value = 0; + hid_t c_prp_id; + CASE = (int)*classtype; + + switch (CASE) { + + case (H5P_FILE_CREATE_F): + c_classtype = H5P_FILE_CREATE; + break; + + case(H5P_FILE_ACCESS_F): + c_classtype = H5P_FILE_ACCESS; + break; + + case(H5P_DATASET_CREATE_F): + c_classtype = H5P_DATASET_CREATE; + break; + + case(H5P_DATASET_XFER_F): + c_classtype = H5P_DATASET_XFER; + break; + + case(H5P_MOUNT_F): + c_classtype = H5P_MOUNT; + break; + + default: + ret_value = -1; + return ret_value; + } + c_prp_id = H5Pcreate(c_classtype); + + if ( c_prp_id < 0 ) ret_value = -1; + *prp_id = (hid_t_f)c_prp_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pclose_c + * Purpose: Call H5Pclose to close property lis + * Inputs: prp_id - identifier of the property list to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pclose_c ( hid_t_f *prp_id ) +{ + int ret_value = 0; + hid_t c_prp_id; + + c_prp_id = *prp_id; + if ( H5Pclose(c_prp_id) < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pcopy_c + * Purpose: Call H5Pcopy to copy property list + * Inputs: prp_id - identifier of the property list to be copied + * Outputs: new_prp_id - identifier of the new property list + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id) +{ + int ret_value = 0; + hid_t c_prp_id; + hid_t c_new_prp_id; + + c_prp_id = *prp_id; + c_new_prp_id = H5Tcopy(c_prp_id); + if ( c_new_prp_id < 0 ) ret_value = -1; + *new_prp_id = (hid_t_f)c_new_prp_id; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_class_c + * Purpose: Call H5Pget_class to determine property list class + * Inputs: prp_id - identifier of the dataspace + * Outputs: classtype - class type; possible values are: + * H5P_NO_CLASS_F -1 + * H5P_FILE_CREATE_F 0 + * H5P_FILE_ACCESS_F 1 + * H5P_DATASET_CREATE_F 2 + * H5P_DATASET_XFER_F 3 + * H5P_MOUNT_F 4 + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype) +{ + int ret_value = 0; + hid_t c_prp_id; + H5P_class_t c_classtype; + + c_prp_id = *prp_id; + c_classtype = H5Pget_class(c_prp_id); + if (c_classtype == H5P_NO_CLASS ) { + *classtype = H5P_NO_CLASS_F; + ret_value = -1; + return ret_value; + } + if (c_classtype == H5P_FILE_CREATE) *classtype = H5P_FILE_CREATE_F; + if (c_classtype == H5P_FILE_ACCESS) *classtype = H5P_FILE_ACCESS_F; + if (c_classtype == H5P_DATASET_CREATE) *classtype = H5P_DATASET_CREATE_F; + if (c_classtype == H5P_DATASET_XFER) *classtype = H5P_DATASET_XFER_F; + if (c_classtype == H5P_MOUNT_F) *classtype = H5P_MOUNT_F; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_preserve_c + * Purpose: Call H5Pset_preserve to set transfer property for compound + * datatype + * Inputs: prp_id - property list identifier + * flag - TRUE/FALSE flag + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, February 17, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_preserve_c ( hid_t_f *prp_id , int_f *flag) +{ + int ret_value = 0; + hid_t c_prp_id; + herr_t status; + hbool_t c_flag = 0; + + if (*flag > 0) c_flag = 1; + c_prp_id = *prp_id; + status = H5Pset_preserve(c_prp_id, c_flag); + if ( status < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_preserve_c + * Purpose: Call H5Pget_preserve to set transfer property for compound + * datatype + * Inputs: prp_id - property list identifier + * Outputs: flag - TRUE/FALSE flag + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, February 17, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_preserve_c ( hid_t_f *prp_id , int_f *flag) +{ + int ret_value = 0; + hid_t c_prp_id; + herr_t status; + int c_flag; + + c_prp_id = *prp_id; + c_flag = H5Pget_preserve(c_prp_id); + if ( c_flag < 0 ) ret_value = -1; + *flag = (int_f)c_flag; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_deflate_c + * Purpose: Call H5Pset_deflate to set deflate level + * Inputs: prp_id - property list identifier + * level - level of deflation + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level) +{ + int ret_value = 0; + hid_t c_prp_id; + int c_level; + herr_t status; + + c_prp_id = *prp_id; + c_level = *level; + status = H5Pset_deflate(c_prp_id, c_level); + if ( status < 0 ) ret_value = -1; + return ret_value; +} + + + +/*---------------------------------------------------------------------------- + * Name: h5pset_chunk_c + * Purpose: Call H5Pset_chunk to set the sizes of chunks for a chunked + * layout dataset + * Inputs: prp_id - property list identifier + * rank - number of dimensions of each chunk + * dims - array of the size of each chunk + * Returns: 0 on success, -1 on failure + * Saturday, August 14, 1999 + * Programmer: Elena Pourmal + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims ) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_rank; + hsize_t *c_dims; + herr_t status; + int i; + + c_dims = malloc(sizeof(hsize_t) * (*rank )); + if (!c_dims) return ret_value; + + /* + * Transpose dimension arrays because of C-FORTRAN storage order + */ + for (i = 0; i < *rank ; i++) { + c_dims[i] = dims[*rank - i - 1]; + } + + c_prp_id = *prp_id; + c_rank = *rank; + status = H5Pset_chunk(c_prp_id, c_rank, c_dims); + if (status < 0) return ret_value; + ret_value = 0; + HDfree (c_dims); + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_chunk_c + * Purpose: Call H5Pget_chunk to get the sizes of chunks for a chunked + * layout dataset for at list max_rank number of dimensions + * Inputs: prp_id - property list identifier + * max rank - maximum number of dimensions to return + * dims - array of the size of each chunk + * Returns: number of chunk's dimnesion on success, -1 on failure + * Saturday, August 14, 1999 + * Programmer: Elena Pourmal + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims ) +{ + int ret_value = -1; + hid_t c_prp_id; + hsize_t *c_dims; + int rank; + int c_max_rank; + int i; + + c_dims = malloc(sizeof(hsize_t) * (*max_rank )); + if (!c_dims) return ret_value; + + c_prp_id = *prp_id; + c_max_rank = *max_rank; + rank = H5Pget_chunk(c_prp_id, c_max_rank, c_dims); + + /* + * Transpose dimension arrays because of C-FORTRAN storage order + */ + for (i = 0; i < *max_rank ; i++) { + dims[*max_rank - i - 1] = c_dims[i]; + } + HDfree (c_dims); + if (rank < 0) return ret_value; + ret_value = (int_f)rank; + return ret_value; +} + + + +/*---------------------------------------------------------------------------- + * Name: h5pset_fill_valuec_c + * Purpose: Call h5pset_fill_value_c to a character fill value + * Inputs: prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - character value + * Returns: 0 on success, -1 on failure + * Saturday, August 14, 1999 + * Programmer: Elena Pourmal + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue) +{ + int ret_value = -1; + + /* + * Call h5pset_fill_value_c function. + */ + ret_value = nh5pset_fill_value_c(prp_id, type_id, _fcdtocp(fillvalue)); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_fill_value_c + * Purpose: Call H5Pset_fill_value to set a fillvalue for a dataset + * Inputs: prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - fillvalue + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) +{ + int ret_value = -1; + hid_t c_prp_id; + hid_t c_type_id; + herr_t ret; + + /* + * Call H5Pset_fill_value function. + */ + c_prp_id = *prp_id; + c_type_id = *type_id; + ret = H5Pset_fill_value(c_prp_id, c_type_id, fillvalue); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_fill_valuec_c + * Purpose: Call h5pget_fill_value_c to a character fill value + * Inputs: prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - character value + * Returns: 0 on success, -1 on failure + * Saturday, August 14, 1999 + * Programmer: Elena Pourmal + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue) +{ + int ret_value = -1; + + /* + * Call h5pget_fill_value_c function. + */ + ret_value = nh5pset_fill_value_c(prp_id, type_id, _fcdtocp(fillvalue)); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_fill_value_c + * Purpose: Call H5Pget_fill_value to set a fillvalue for a dataset + * Inputs: prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - fillvalue + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) +{ + int ret_value = -1; + hid_t c_prp_id; + hid_t c_type_id; + herr_t ret; + + /* + * Call H5Pget_fill_value function. + */ + c_prp_id = *prp_id; + c_type_id = *type_id; + ret = H5Pget_fill_value(c_prp_id, c_type_id, fillvalue); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_version_c + * Purpose: Call H5Pget_version to get the version information + * of various objects for a file creation property list + * Inputs: prp_id - property list identifier + * Outputs: boot - array to put boot block version number + * freelist - array to put global freelist version number + * stab - array to put symbol table version number + * shhdr - array to put shared object header version number + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: Removed extra length parameters EP 7/6/00 + *---------------------------------------------------------------------------*/ +int_f +nh5pget_version_c (hid_t_f *prp_id, int_f * boot,int_f * freelist, int_f * stab, int_f *shhdr) +{ + int ret_value = -1; + hid_t c_prp_id; + int i; + herr_t ret; + int c_boot; + int c_freelist; + int c_stab; + int c_shhdr; + + /* + * Call H5Pget_version function. + */ + c_prp_id = *prp_id; + ret = H5Pget_version(c_prp_id, &c_boot, &c_freelist, &c_stab, &c_shhdr); + *boot = (int_f)c_boot; + *freelist = (int_f)c_freelist; + *stab = (int_f)c_stab; + *shhdr = (int_f)c_shhdr; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_userblock_c + * Purpose: Call H5Pget_userblock to get the size of a user block in + * a file creation property list + * Inputs: prp_id - property list identifier + * Outputs size - Size of the user-block in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_userblock_c (hid_t_f *prp_id, hsize_t_f * size) +{ + int ret_value = -1; + hid_t c_prp_id; + int i; + herr_t ret; + hsize_t c_size; + + /* + * Call H5Pget_userblock function. + */ + c_prp_id = *prp_id; + ret = H5Pget_userblock(c_prp_id, &c_size); + + *size = (hsize_t_f)c_size; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_userblock_c + * Purpose: Call H5Pset_userblock to set the size of a user block in + * a file creation property list + * Inputs: prp_id - property list identifier + * size - Size of the user-block in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_userblock_c (hid_t_f *prp_id, hsize_t_f * size) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_size; + c_size = (hsize_t)*size; + + /* + * Call H5Pset_userblock function. + */ + c_prp_id = *prp_id; + ret = H5Pset_userblock(c_prp_id, c_size); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_sizes_c + * Purpose: Call H5Pget_sizes to get the size of the offsets + * and lengths used in an HDF5 file + * Inputs: prp_id - property list identifier + * Outputs sizeof_addr - Size of an object offset in bytes + * sizeof_size - Size of an object length in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: Deleted extra length parameters. EP 6/7/00 + *---------------------------------------------------------------------------*/ +int_f +nh5pget_sizes_c (hid_t_f *prp_id, size_t_f * sizeof_addr, size_t_f * sizeof_size) +{ + int ret_value = -1; + hid_t c_prp_id; + int i; + herr_t ret; + size_t c_sizeof_addr; + size_t c_sizeof_size; + + /* + * Call H5Pget_sizes function. + */ + c_prp_id = *prp_id; + ret = H5Pget_sizes(c_prp_id, &c_sizeof_addr, &c_sizeof_size); + + *sizeof_addr = (size_t_f)c_sizeof_addr; + *sizeof_size = (size_t_f)c_sizeof_size; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_sizes_c + * Purpose: Call H5Pset_sizes to set the size of the offsets + * Inputs: prp_id - property list identifier + * sizeof_addr - Size of an object offset in bytes + * sizeof_size - Size of an object length in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_sizes_c (hid_t_f *prp_id, size_t_f * sizeof_addr, size_t_f * sizeof_size) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + size_t c_addr, c_size; + c_addr = (size_t)*sizeof_addr; + c_size = (size_t)*sizeof_size; + + /* + * Call H5Pset_sizes function. + */ + c_prp_id = *prp_id; + ret = H5Pset_sizes(c_prp_id, c_addr, c_size); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_sym_k_c + * Purpose: Call H5Pset_sym_k to set the size of parameters used + * to control the symbol table node + * Inputs: prp_id - property list identifier + * ik - Symbol table tree rank + * lk - Symbol table node size + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_sym_k_c (hid_t_f *prp_id, int_f* ik, int_f* lk) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_ik; + int c_lk; + herr_t ret; + + /* + * Call H5Pset_sym_k function. + */ + c_prp_id = *prp_id; + c_ik = *ik; + c_lk = *lk; + ret = H5Pset_sym_k(c_prp_id, c_ik, c_lk); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_sym_k_c + * Purpose: Call H5Pget_sym_k to get the size of parameters used + * to control the symbol table node + * Inputs: prp_id - property list identifier + * Outputs: ik - Symbol table tree rank + * lk - Symbol table node size + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_sym_k_c (hid_t_f *prp_id, int_f* ik, int_f* lk) +{ + int ret_value = -1; + hid_t c_prp_id; + int i; + herr_t ret; + int c_ik; + int c_lk; + + /* + * Call H5Pget_sym_k function. + */ + c_prp_id = *prp_id; + ret = H5Pget_sym_k(c_prp_id, &c_ik, &c_lk); + *ik = (int_f)c_ik; + *lk = (int_f)c_lk; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_istore_k_c + * Purpose: Call H5Pset_istore_k to set the size of the parameter + * used to control the B-trees for indexing chunked datasets + * Inputs: prp_id - property list identifier + * ik - Symbol table tree rank + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_istore_k_c (hid_t_f *prp_id, int_f* ik) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_ik; + herr_t ret; + + /* + * Call H5Pset_istore_k function. + */ + c_prp_id = *prp_id; + c_ik = *ik; + ret = H5Pset_istore_k(c_prp_id, c_ik); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_istore_k_c + * Purpose: Call H5Pget_istore_k to get the size of parameters used + * to control the B-trees for indexing chunked datasets + * Inputs: prp_id - property list identifier + * Outputs: ik - Symbol table tree rank + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_istore_k_c (hid_t_f *prp_id, int_f* ik) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + int c_ik; + + /* + * Call H5Pget_istore_k function. + */ + c_prp_id = *prp_id; + ret = H5Pget_istore_k(c_prp_id, &c_ik); + *ik = (int_f)c_ik; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_driver_c + * Purpose: Call H5Pget_driver to get low-level file driver identifier + * Inputs: prp_id - property list identifier + * Outputs: driver - low-level file driver identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_driver_c (hid_t_f *prp_id, int_f* driver) +{ + int ret_value = -1; + hid_t c_prp_id; + H5F_driver_t c_driver; + + /* + * Call H5Pget_driver function. + */ + c_prp_id = *prp_id; + c_driver = H5Pget_driver(c_prp_id); + *driver = (int_f) c_driver; + if (c_driver < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_stdio_c + * Purpose: Call H5Pset_stdio to set the low level file driver to + * use the functions declared in the stdio.h + * Inputs: prp_id - property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_stdio_c (hid_t_f *prp_id) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + /* + * Call H5Pset_stdio function. + */ + c_prp_id = *prp_id; + ret = H5Pset_stdio(c_prp_id); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_stdio_c + * Purpose: Call H5Pget_stdio to determine whther the low level file driver + * uses the functions declared in the stdio.h + * Inputs: prp_id - property list identifier + * Outputs: io - value indicates whether the file driver uses + * the functions declared in the stdio.h + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_stdio_c (hid_t_f *prp_id, int_f* io) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + /* + * Call H5Pget_stdio function. + */ + c_prp_id = *prp_id; + ret = H5Pget_stdio(c_prp_id); + if (ret < 0) return ret_value; + *io = (int_f)ret; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_sec2_c + * Purpose: Call H5Pset_sec2 to set the low level file driver to + * use the functions declared in the unistd.h + * Inputs: prp_id - property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_sec2_c (hid_t_f *prp_id) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + /* + * Call H5Pset_sec2 function. + */ + c_prp_id = *prp_id; + ret = H5Pset_sec2(c_prp_id); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_sec2_c + * Purpose: Call H5Pget_stdio to determine whther the low level file driver + * uses the functions declared in the unistd.h + * Inputs: prp_id - property list identifier + * Outputs: sec2 - value indicates whether the file driver uses + * the functions declared in the unistd.h + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_sec2_c (hid_t_f *prp_id, int_f* sec2) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + /* + * Call H5Pget_sec2 function. + */ + c_prp_id = *prp_id; + ret = H5Pget_sec2(c_prp_id); + if (ret < 0) return ret_value; + *sec2 = (int_f)ret; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_alignment_c + * Purpose: Call H5Pset_alignment to set alignment properties of + * a file access property list + * Inputs: prp_id - property list identifier + * threshold - Threshold value + * alignment - Alignment value + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_alignment_c (hid_t_f *prp_id, hsize_t_f* threshold, hsize_t_f* alignment) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_threshold, c_alignment; + c_threshold = *threshold; + c_alignment = * alignment; + /* + * Call H5Pset_alignment function. + */ + c_prp_id = *prp_id; + ret = H5Pset_alignment(c_prp_id, c_threshold, c_alignment); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_alignment_c + * Purpose: Call H5Pget_alignment to get alignment properties of + * a file access property list + * Inputs: prp_id - property list identifier + * threshold - Threshold value + * alignment - Alignment value + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_alignment_c (hid_t_f *prp_id, hsize_t_f* threshold, hsize_t_f* alignment) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_threshold, c_alignment; + /* + * Call H5Pget_alignment function. + */ + c_prp_id = *prp_id; + ret = H5Pget_alignment(c_prp_id, &c_threshold, &c_alignment); + if (ret < 0) return ret_value; + *threshold = (hsize_t_f)c_threshold; + *alignment = (hsize_t_f)c_alignment; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_core_c + * Purpose: Call H5Pset_core to set the low-level file driver + * to use malloc() and free() + * Inputs: prp_id - property list identifier + * increment - File block size in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_core_c (hid_t_f *prp_id, size_t_f* increment) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + size_t c_increment; + c_increment = (size_t)*increment; + /* + * Call H5Pset_core function. + */ + c_prp_id = *prp_id; + ret = H5Pset_core(c_prp_id, c_increment); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_core_c + * Purpose: Call H5Pget_core to determine whether the file access + * property list is set to the core drive + * Inputs: prp_id - property list identifier + * Outputs increment - File block size in bytes + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_core_c (hid_t_f *prp_id, size_t_f* increment) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + size_t c_increment; + /* + * Call H5Pset_increment function. + */ + c_prp_id = *prp_id; + ret = H5Pget_core(c_prp_id, &c_increment); + if (ret < 0) return ret_value; + *increment = (size_t_f)c_increment; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_family_c + * Purpose: Call H5Pset_family to set the file access properties list + * to the family driver + * Inputs: prp_id - property list identifier + * memb_size - Logical size, in bytes, of each family member. + * memb_plist - Identifier of the file access property list + * for each member of the family + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_family_c(hid_t_f *prp_id, hsize_t_f* memb_size, hid_t_f* memb_plist ) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_memb_size; + hid_t c_memb_plist; + c_memb_size =(hsize_t) *memb_size; + c_memb_plist =(hsize_t) *memb_plist; + /* + * Call H5Pset_family function. + */ + c_prp_id = *prp_id; + ret = H5Pset_family(c_prp_id, c_memb_size, c_memb_plist); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_family_c + * Purpose: Call H5Pget_family to determine whether the file access + * property list is set to the family driver + * Inputs: prp_id - property list identifier + * memb_size - Logical size, in bytes, of each family member. + * memb_plist - Identifier of the file access property list + * for each member of the family + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_family_c(hid_t_f *prp_id, hsize_t_f* memb_size, hid_t_f* memb_plist) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_memb_size; + hid_t c_memb_plist; + /* + * Call H5Pget_family function. + */ + c_prp_id = *prp_id; + ret = H5Pget_family(c_prp_id, &c_memb_size, &c_memb_plist); + if (ret < 0) return ret_value; + *memb_size = (hsize_t_f)c_memb_size; + *memb_plist = (hsize_t_f)c_memb_plist; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_cache_c + * Purpose: Call H5Pset_cache to set he number of elements in + * the meta data cache and the total number of bytes in + * the raw data chunk cache + * Inputs: prp_id - property list identifier + * mdc_nelmts - Number of elements (objects) in the + * meta data cache + * rdcc_nbytes - Total size of the raw data chunk cache, in bytes + * rdcc_w0 - Preemption policy + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: Changed the type of the rdcc_w0 parameter to be real_f EP 7/7/00 + * instead of double + *---------------------------------------------------------------------------*/ +int_f +nh5pset_cache_c(hid_t_f *prp_id, int_f* mdc_nelmts, int_f* rdcc_nelmts, size_t_f* rdcc_nbytes , real_f* rdcc_w0 ) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + int c_mdc_nelmts; + int c_rdcc_nelmts; + size_t c_rdcc_nbytes; + double c_rdcc_w0; + c_rdcc_nbytes =(size_t) *rdcc_nbytes; + c_rdcc_w0 = (double)*rdcc_w0; + + /* + * Call H5Pset_cache function. + */ + c_prp_id = *prp_id; + c_mdc_nelmts = *mdc_nelmts; + c_rdcc_nelmts = *rdcc_nelmts; + ret = H5Pset_cache(c_prp_id, c_mdc_nelmts, c_rdcc_nelmts, c_rdcc_nbytes, c_rdcc_w0 ); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_cache_c + * Purpose: Call H5Pget_cache to get he number of elements in + * the meta data cache and the total number of bytes in + * the raw data chunk cache + * Inputs: prp_id - property list identifier + * Outputs: mdc_nelmts - Number of elements (objects) in the + * meta data cache + * rdcc_nelmts - Number of elements in the raw data chunk + * rdcc_nbytes - Total size of the raw data chunk cache, in bytes + * rdcc_w0 - Preemption policy + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: Changed type of the rdcc_w0 parameter to be real_f instead of double + *---------------------------------------------------------------------------*/ +int_f +nh5pget_cache_c(hid_t_f *prp_id, int_f* mdc_nelmts, int_f* rdcc_nelmts, size_t_f* rdcc_nbytes , real_f* rdcc_w0) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + int c_mdc_nelmts, c_rdcc_nelmts; + size_t c_rdcc_nbytes; + hid_t c_memb_plist; + double c_rdcc_w0; + /* + * Call H5Pget_cache function. + */ + c_prp_id = *prp_id; + ret = H5Pget_cache(c_prp_id, &c_mdc_nelmts, &c_rdcc_nelmts, &c_rdcc_nbytes, &c_rdcc_w0); + if (ret < 0) return ret_value; + *mdc_nelmts = (int_f)c_mdc_nelmts; + *rdcc_nelmts = (int_f)c_rdcc_nelmts; + *rdcc_nbytes = (size_t_f)c_rdcc_nbytes; + *rdcc_w0 = (real_f)c_rdcc_w0; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_split_c + * Purpose: Call H5Pset_split to set he low-level driver to split meta data + * from raw data + * Inputs: prp_id - property list identifier + * meta_len - Length of meta_ext + * meta_ext - Name of the extension for the metafile filename. + * meta_plist - Identifier of the meta file access property list + * raw_len - Length of raw _ext + * raw_ext - Name of the extension for the raw file filename. + * raw_plist - Identifier of the raw file access property list + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_split_c(hid_t_f *prp_id, int_f* meta_len, _fcd meta_ext, hid_t_f* meta_plist, int_f* raw_len, _fcd raw_ext, hid_t_f * raw_plist) +{ + int ret_value = -1; + hid_t c_prp_id; + hid_t c_meta_plist; + hid_t c_raw_plist; + herr_t ret; + char* c_meta_ext; + char* c_raw_ext; + c_meta_ext = (char *)HD5f2cstring(meta_ext, (int)*meta_len); + if (c_meta_ext == NULL) return ret_value; + c_raw_ext = (char *)HD5f2cstring(raw_ext, (int)*raw_len); + if (c_raw_ext == NULL) return ret_value; + + /* + * Call H5Pset_split function. + */ + c_prp_id = *prp_id; + c_meta_plist = *meta_plist; + c_raw_plist = *raw_plist; + ret = H5Pset_split(c_prp_id, c_meta_ext, c_meta_plist, c_raw_ext, c_raw_plist ); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_split_c + * Purpose: Call H5Pget_split to determine whether the file access + * property list is set to the split driver + * Inputs: prp_id - property list identifier + * meta_ext_size - Number of characters of the meta file extension + * to be copied to the meta_ext buffer + * raw_ext_size - Number of characters of the raw file extension + * to be copied to the raw_ext buffer + *Outputs: meta_ext - Name of the extension for the metafile filename. + * meta_plist - Identifier of the meta file access property list + * raw_ext - Name of the extension for the raw file filename. + * raw_plist - Identifier of the raw file access property list + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_split_c(hid_t_f *prp_id, size_t_f* meta_ext_size , _fcd meta_ext, hid_t_f* meta_plist, size_t_f* raw_ext_size, _fcd raw_ext, hid_t_f * raw_plist) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + size_t c_meta_ext_size, c_raw_ext_size; + hid_t c_meta_plist, c_raw_plist; + + char* c_meta_ext; + char* c_raw_ext; + + c_meta_ext_size = (size_t) *meta_ext_size; + c_raw_ext_size = (size_t) *raw_ext_size; + c_meta_ext = (char*)malloc(sizeof(char)*c_meta_ext_size); + c_raw_ext = (char*)malloc(sizeof(char)*c_raw_ext_size); + if(c_meta_ext == NULL || c_raw_ext == NULL) return ret_value; + + /* + * Call H5Pget_split function. + */ + c_prp_id = *prp_id; + ret = H5Pget_split(c_prp_id, c_meta_ext_size, c_meta_ext,&c_meta_plist, c_raw_ext_size, c_raw_ext, &c_raw_plist ); + + if (ret < 0) return ret_value; + *meta_plist = c_meta_plist; + *raw_plist = c_raw_plist; + HDpackFstring(c_meta_ext, _fcdtocp(meta_ext), strlen(c_meta_ext)); + HDpackFstring(c_raw_ext, _fcdtocp(raw_ext), strlen(c_raw_ext)); + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_gc_references_c + * Purpose: Call H5Pset_gc_references to set garbage + * collecting references flag + * Inputs: prp_id - property list identifier + * gc_reference - flag for garbage collecting references + * for the file + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_gc_references_c (hid_t_f *prp_id, int_f* gc_references) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + unsigned c_gc_references; + c_gc_references = (unsigned)*gc_references; + + /* + * Call H5Pset_gc_references function. + */ + c_prp_id = *prp_id; + ret = H5Pset_gc_references(c_prp_id, c_gc_references); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_gc_references_c + * Purpose: Call H5Pget_gc_references to set garbage + * collecting references flag + * Inputs: prp_id - property list identifier + * Outputs gc_reference - flag for garbage collecting references + * for the file + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_gc_references_c (hid_t_f *prp_id, int_f* gc_references) +{ + int ret_value = -1; + hid_t c_prp_id; + unsigned c_gc_references; + herr_t ret; + /* + * Call H5Pget_gc_references function. + */ + c_prp_id = *prp_id; + ret = H5Pget_gc_references(c_prp_id, &c_gc_references); + if (ret < 0) return ret_value; + *gc_references = (int_f)c_gc_references; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_layout_c + * Purpose: Call H5Pset_layout to the type of storage used + * store the raw data for a dataset + * Inputs: prp_id - property list identifier + * layout - Type of storage layout for raw data. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_layout_c (hid_t_f *prp_id, int_f* layout) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + H5D_layout_t c_layout; + c_layout = (H5D_layout_t)*layout; + /* + * Call H5Pset_layout function. + */ + c_prp_id = *prp_id; + ret = H5Pset_layout(c_prp_id, c_layout); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_layout_c + * Purpose: Call H5Pget_layout to the type of storage used + * store the raw data for a dataset + * Inputs: prp_id - property list identifier + * Outputs: layout - Type of storage layout for raw data. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_layout_c (hid_t_f *prp_id, int_f* layout) +{ + int ret_value = -1; + hid_t c_prp_id; + H5D_layout_t c_layout; + /* + * Call H5Pget_layout function. + */ + c_prp_id = *prp_id; + c_layout = H5Pget_layout(c_prp_id); + if (c_layout < 0) return ret_value; + *layout = (int_f)c_layout; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_filter_c + * Purpose: Call H5Pset_filter to add a filter to the filter pipeline. + * Inputs: prp_id - property list identifier + * filter - Filter to be added to the pipeline. + * flags - Bit vector specifying certain general + * properties of the filter. + * cd_nelmts - Number of elements in cd_values. + * cd_values - Auxiliary data for the filter. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_filter_c (hid_t_f *prp_id, int_f* filter, int_f* flags, size_t_f* cd_nelmts, int_f* cd_values ) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + size_t c_cd_nelmts; + unsigned int c_flags; + H5Z_filter_t c_filter; + unsigned int * c_cd_values; + int i; + + c_filter = (H5Z_filter_t)*filter; + c_flags = (unsigned)*flags; + c_cd_nelmts = (size_t)*cd_nelmts; + c_cd_values = (unsigned int*)malloc(sizeof(unsigned int)*((int)c_cd_nelmts)); + if (!c_cd_values) return ret_value; + for (i = 0; i < c_cd_nelmts; i++) + c_cd_values[i] = (unsigned int)cd_values[i]; + + /* + * Call H5Pset_filter function. + */ + c_prp_id = *prp_id; + ret = H5Pset_filter(c_prp_id, c_filter, c_flags, c_cd_nelmts,c_cd_values ); + + if (ret < 0) return ret_value; + ret_value = 0; + free(c_cd_values); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_nfilters_c + * Purpose: Call H5Pget_nfilters to get the number of filters + * in the pipeline + * Inputs: prp_id - property list identifier + * Outputs: nfilters - number of filters defined in the filter pipline + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_nfilters_c (hid_t_f *prp_id, int_f* nfilters) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_nfilters; + /* + * Call H5Pget_nfilters function. + */ + c_prp_id = *prp_id; + c_nfilters = H5Pget_nfilters(c_prp_id); + if (c_nfilters < 0) return ret_value; + *nfilters = (int_f)c_nfilters; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_filter_c + * Purpose: Call H5Pget_filter to get information about a filter + * in a pipeline + * Inputs: prp_id - property list identifier + * filter_number - Sequence number within the filter + * pipeline of the filter for which + * information is sought. + * namelen - Anticipated number of characters in name. + *Outputs: flags - Bit vector specifying certain general + * properties of the filter. + * cd_nelmts - Number of elements in cd_value + * cd_values - Auxiliary data for the filter. + * name - Name of the filter + * filter_id - filter identification number + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_filter_c(hid_t_f *prp_id, int_f* filter_number, int_f* flags, size_t_f* cd_nelmts, int_f* cd_values, size_t_f *namelen, _fcd name, int_f* filter_id) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_filter_number; + unsigned int c_flags; + size_t c_cd_nelmts, c_namelen; + H5Z_filter_t c_filter; + unsigned int * c_cd_values; + char* c_name; + int i; + + c_cd_nelmts = (size_t)*cd_nelmts; + c_namelen = (size_t)*namelen; + c_name = (char*)malloc(sizeof(char)*c_namelen); + if (!c_name) return ret_value; + + c_cd_values = (unsigned int*)malloc(sizeof(unsigned int)*((int)c_cd_nelmts)); + if (!c_cd_values) return ret_value; + + /* + * Call H5Pget_filter function. + */ + c_prp_id = *prp_id; + c_filter_number = *filter_number; + c_filter = H5Pget_filter(c_prp_id, c_filter_number, &c_flags, &c_cd_nelmts, c_cd_values, c_namelen, c_name); + + if (c_filter < 0) return ret_value; + + *filter_id = c_filter; + *cd_nelmts = c_cd_nelmts; + *flags = c_flags; + HDpackFstring(c_name, _fcdtocp(name), strlen(c_name)); + + for (i = 0; i < c_cd_nelmts; i++) + cd_values[i] = (int_f)c_cd_values[i]; + + HDfree(c_name); + HDfree(c_cd_values); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_external_c + * Purpose: Call H5Pset_external to add an external file to the + * list of external files. + * Inputs: prp_id - property list identifier + * name - Name of an external file + * namelen - length of name + * offset - Offset, in bytes, from the beginning of the file + * to the location in the file where the data starts. + * bytes - Number of bytes reserved in the file for the data. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_external_c (hid_t_f *prp_id, _fcd name, int_f* namelen, int_f* offset, hsize_t_f*bytes) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + hsize_t c_bytes; + char* c_name; + int c_namelen; + off_t c_offset; + + c_bytes = (hsize_t) *bytes; + c_offset = (off_t)*offset; + + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Pset_external function. + */ + c_prp_id = *prp_id; + ret = H5Pset_external(c_prp_id, c_name, c_offset, c_bytes); + + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_external_count_c + * Purpose: Call H5Pget_external_count to get the number of external + * files for the specified dataset. + * Inputs: prp_id - property list identifier + * Outputs: count - number of external files + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_external_count_c (hid_t_f *prp_id, int_f* count) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_count; + /* + * Call H5Pget_external_count function. + */ + c_prp_id = *prp_id; + c_count = H5Pget_external_count(c_prp_id); + if (c_count < 0) return ret_value; + *count = (int_f)c_count; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_external_c + * Purpose: Call H5Pget_external to get nformation about an external file. + * Inputs: prp_id - property list identifier + * name_size - length of name + * idx - External file index. + *Outputs: name - Name of an external file + * offset - Offset, in bytes, from the beginning of the file + * to the location in the file where the data starts. + * bytes - Number of bytes reserved in the file for the data. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, February 23, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_external_c(hid_t_f *prp_id,int*idx, size_t_f* name_size, _fcd name, int_f* offset, hsize_t_f*bytes) +{ + int ret_value = -1; + hid_t c_prp_id; + int c_idx; + herr_t status; + size_t c_namelen; + char* c_name; + int i; + off_t c_offset; + hsize_t size; + + c_namelen = (size_t)*name_size; + /* + * Allocate memory to store the name of the external file. + */ + if(c_namelen) c_name = (char*) HDmalloc(c_namelen + 1); + + /* + * Call H5Pget_external function. + */ + c_prp_id = *prp_id; + c_idx = *idx; + status = H5Pget_external(c_prp_id, c_idx, c_namelen, c_name, &c_offset, &size ); + + if (status < 0) { + HDfree(c_name); + return ret_value; + } + + *offset = (int_f)c_offset; + *bytes = (hsize_t_f)size; + HDpackFstring(c_name, _fcdtocp(name), strlen(c_name)); + + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_hyper_cache_c + * Purpose: Call H5Pset__hyper_cache to indicate whether to + * cache hyperslab blocks during I/O. + * Inputs: prp_id - property list identifier + * cache - + * limit - Maximum size of the hyperslab block to cache. + * 0 (zero) indicates no limit. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_hyper_cache_c(hid_t_f *prp_id, int_f* cache, int_f* limit) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + unsigned c_cache, c_limit; + c_cache = (unsigned) *cache; + c_limit = (unsigned) *limit; + + /* + * Call H5Pset_hyper_cache function. + */ + c_prp_id = *prp_id; + ret = H5Pset_hyper_cache(c_prp_id, c_cache, c_limit); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_hyper_cache_c + * Purpose: Call H5Pget_hyper_cache to get information regarding + * the caching of hyperslab blocks + * Inputs: prp_id - property list identifier + * cache - + * limit - Maximum size of the hyperslab block to cache. + * 0 (zero) indicates no limit. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_hyper_cache_c(hid_t_f *prp_id, int_f* cache, int_f* limit) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + unsigned c_cache, c_limit; + /* + * Call H5Pget__hyper_cache function. + */ + c_prp_id = *prp_id; + ret = H5Pget_hyper_cache(c_prp_id, &c_cache, &c_limit); + if (ret < 0) return ret_value; + *cache = (int_f)c_cache; + *limit = (int_f)c_limit; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_btree_ratios_c + * Purpose: Call H5Pset_btree_ratios to set B-tree split ratios for B-tree split ratios for a dataset transfer property list. a + * dataset transfer property list. + * Inputs: prp_id - property list identifier + * left - The B-tree split ratio for left-most nodes. + * middle - The B-tree split ratio for all other nodes + * right - The B-tree split ratio for right-most nodes + * and lone nodes. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: Changed the type of the last three parameters from double to real_f + *---------------------------------------------------------------------------*/ +int_f +nh5pset_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* right) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + double c_left; + double c_middle; + double c_right; + c_left = (double)*left; + c_middle = (double)*middle; + c_right = (double)*right; + + /* + * Call H5Pset_btree_ratios function. + */ + c_prp_id = *prp_id; + ret = H5Pset_btree_ratios(c_prp_id, c_left, c_middle, c_right); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_btree_ratios_c + * Purpose: Call H5Pget_btree_ratios to Gets B-tree split ratios + * for a dataset transfer property list. + * Inputs: prp_id - property list identifier + * left - The B-tree split ratio for left-most nodes. + * middle - The B-tree split ratio for all other nodes + * right - The B-tree split ratio for right-most nodes + * and lone nodes. + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, February 25, 2000 + * Modifications: Changed the type of the last three parameters from double to real_f + *---------------------------------------------------------------------------*/ +int_f +nh5pget_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* right) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + double c_left, c_right, c_middle; + + /* + * Call H5Pget_btree_ratios function. + */ + c_prp_id = *prp_id; + ret = H5Pget_btree_ratios(c_prp_id, &c_left, &c_middle, &c_right); + *left = (real_f)c_left; + *middle = (real_f)c_middle; + *right = (real_f)c_right; + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Pf_parallel.c b/fortran/src/H5Pf_parallel.c new file mode 100644 index 0000000..6dc0850 --- /dev/null +++ b/fortran/src/H5Pf_parallel.c @@ -0,0 +1,161 @@ +#include "H5f90.h" +#include <mpi.h> + +/*---------------------------------------------------------------------------- + * Name: h5pset_mpi_c + * Purpose: Call H5Pset_mpi to set mode for parallel I/O and the user + * supplied communicator and info object + * Inputs: prp_id - property list identifier + * comm - MPI communicator + * info - MPI info object + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, June 8, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_mpi_c(hid_t_f *prp_id, int_f* comm, int_f* info) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + MPI_Comm c_comm; + MPI_Info c_info; + c_comm = (MPI_Comm) *comm; + c_info = (MPI_Info) *info; + + /* + * Call H5Pset_mpi function. + */ + c_prp_id = *prp_id; + ret = H5Pset_mpi(c_prp_id, c_comm, c_info); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_mpi_c + * Purpose: Call H5Pget_mpi to retrieve communicator and info object + * Inputs: prp_id - property list identifier + * comm - buffer to return MPI communicator + * info - buffer to return MPI info object + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, June 8, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_mpi_c(hid_t_f *prp_id, int_f* comm, int_f* info) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + MPI_Comm c_comm; + MPI_Info c_info; + + /* + * Call H5Pget_mpi function. + */ + c_prp_id = *prp_id; + ret = H5Pget_mpi(c_prp_id, &c_comm, &c_info); + if (ret < 0) return ret_value; + *comm = (int_f) c_comm; + *info = (int_f) c_info; + ret_value = 0; + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5pset_xfer_c + * Purpose: Call H5Pset_xfer to set transfer mode of the dataset + * trasfer property list + * Inputs: prp_id - property list identifier + * data_xfer_mode - transfer mode + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, June 15, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_xfer_c(hid_t_f *prp_id, int_f* data_xfer_mode) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + H5D_transfer_t c_data_xfer_mode; + int CASE; + CASE = *data_xfer_mode; + switch (CASE) { + + case H5D_XFER_INDEPENDENT_F: + c_data_xfer_mode = H5D_XFER_INDEPENDENT; + break; + + case H5D_XFER_COLLECTIVE_F: + c_data_xfer_mode = H5D_XFER_COLLECTIVE; + break; + + case H5D_XFER_DFLT_F: + c_data_xfer_mode = H5D_XFER_DFLT; + break; + default: + return ret_value; + } + /* + * Call H5Pset_xfer function. + */ + c_prp_id = *prp_id; + ret = H5Pset_xfer(c_prp_id, c_data_xfer_mode); + if (ret < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_xfer_c + * Purpose: Call H5Pget_xfer to get transfer mode of the dataset + * trasfer property list + * Inputs: prp_id - property list identifier + * data_xfer_mode - buffer to retrieve transfer mode + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, June 15, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_xfer_c(hid_t_f *prp_id, int_f* data_xfer_mode) +{ + int ret_value = -1; + hid_t c_prp_id; + herr_t ret; + H5D_transfer_t c_data_xfer_mode; + int CASE; + + /* + * Call H5Pget_xfer function. + */ + c_prp_id = *prp_id; + ret = H5Pget_xfer(c_prp_id, &c_data_xfer_mode); + if (ret < 0) return ret_value; + + CASE = (int)c_data_xfer_mode; + switch (CASE) { + + case H5D_XFER_INDEPENDENT: + *data_xfer_mode = H5D_XFER_INDEPENDENT_F; + break; + + case H5D_XFER_COLLECTIVE: + *data_xfer_mode = H5D_XFER_COLLECTIVE_F; + break; + + case H5D_XFER_DFLT: + *data_xfer_mode = H5D_XFER_DFLT_F; + break; + + default: + return ret_value; + } + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 new file mode 100644 index 0000000..ec3414c --- /dev/null +++ b/fortran/src/H5Pff.f90 @@ -0,0 +1,744 @@ +! +! This file contains Fortran90 interfaces for H5P functions. +! + MODULE H5P + + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + INTERFACE h5pset_fill_value_f + MODULE PROCEDURE h5pset_fill_value_integer + MODULE PROCEDURE h5pset_fill_value_real +! Comment if on T3E + MODULE PROCEDURE h5pset_fill_value_double +! End comment if on T3E + MODULE PROCEDURE h5pset_fill_value_char + END INTERFACE + + INTERFACE h5pget_fill_value_f + MODULE PROCEDURE h5pget_fill_value_integer + MODULE PROCEDURE h5pget_fill_value_real +! Comment if on T3E + MODULE PROCEDURE h5pget_fill_value_double +! End comment if on T3E + MODULE PROCEDURE h5pget_fill_value_char + END INTERFACE + + CONTAINS + + SUBROUTINE h5pcreate_f(classtype, prp_id, hdferr) + IMPLICIT NONE + INTEGER, INTENT(IN) :: classtype ! The type of the property list + ! to be created. Possible values + ! are: + ! H5P_FILE_CREATE_F (0) + ! H5P_FILE_ACCESS_F (1) + ! H5P_DATASET_CREATE_F (2) + ! H5P_DATASET_XFER_F (3) + ! H5P_MOUNT_F (4) + INTEGER(HID_T), INTENT(OUT) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pcreate_c + hdferr = h5pcreate_c(classtype, prp_id) + END SUBROUTINE h5pcreate_f + + + SUBROUTINE h5pset_preserve_f(prp_id, flag, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: flag ! TRUE/FALSE flag to set the dataset + ! transfer property for partila writing/reading + ! compound datatype + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_preserve_c + hdferr = h5pset_preserve_c(prp_id, flag) + END SUBROUTINE h5pset_preserve_f + + SUBROUTINE h5pget_preserve_f(prp_id, flag, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: flag ! TRUE/FALSE flag. Shows status of the dataset's + ! transfer property for partial writing/reading + ! compound datatype + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_preserve_c + hdferr = h5pget_preserve_c(prp_id, flag) + END SUBROUTINE h5pget_preserve_f + + SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: classtype ! The type of the property list + ! to be created. Possible values + ! are: + ! H5P_NO_CLASS (-1) + ! H5P_FILE_CREATE_F (0) + ! H5P_FILE_ACCESS_F (1) + ! H5PE_DATASET_CREATE_F (2) + ! H5P_DATASET_XFER_F (3) + ! H5P_MOUNT_F (4) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_class_c + hdferr = h5pget_class_c(prp_id, classtype) + END SUBROUTINE h5pget_class_f + + + SUBROUTINE h5pcopy_f(prp_id, new_prp_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(OUT) :: new_prp_id + ! Identifier of property list + ! copy + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pcopy_c + hdferr = h5pcopy_c(prp_id, new_prp_id) + END SUBROUTINE h5pcopy_f + + + SUBROUTINE h5pclose_f(prp_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pclose_c + hdferr = h5pclose_c(prp_id) + END SUBROUTINE h5pclose_f + + + SUBROUTINE h5pset_chunk_f(prp_id, ndims, dims, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions + INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(IN) :: dims + ! Array containing sizes of + ! chunk dimensions + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_chunk_c + hdferr = h5pset_chunk_c(prp_id, ndims, dims) + END SUBROUTINE h5pset_chunk_f + + + SUBROUTINE h5pget_chunk_f(prp_id, ndims, dims, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: ndims ! Number of chunk dimensions to + ! to return + INTEGER(HSIZE_T), DIMENSION(ndims), INTENT(OUT) :: dims + ! Array containing sizes of + ! chunk dimensions + INTEGER, INTENT(OUT) :: hdferr ! Error code; number of + ! chunk dimensions on success, + ! -1 on failure + INTEGER, EXTERNAL :: h5pget_chunk_c + hdferr = h5pget_chunk_c(prp_id, ndims, dims) + END SUBROUTINE h5pget_chunk_f + + + SUBROUTINE h5pset_deflate_f(prp_id, level, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: level ! Compression level + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_deflate_c + hdferr = h5pset_deflate_c(prp_id, level) + END SUBROUTINE h5pset_deflate_f + + + SUBROUTINE h5pset_fill_value_integer(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + INTEGER, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_fill_value_c + hdferr = h5pset_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pset_fill_value_integer + + + SUBROUTINE h5pget_fill_value_integer(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + INTEGER, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_fill_value_c + hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pget_fill_value_integer + + + SUBROUTINE h5pset_fill_value_real(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + REAL, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_fill_value_c + hdferr = h5pset_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pset_fill_value_real + + + SUBROUTINE h5pget_fill_value_real(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + REAL, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_fill_value_c + hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pget_fill_value_real + + + SUBROUTINE h5pset_fill_value_double(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + DOUBLE PRECISION, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_fill_value_c + hdferr = h5pset_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pset_fill_value_double + + + SUBROUTINE h5pget_fill_value_double(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + DOUBLE PRECISION, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_fill_value_c + hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pget_fill_value_double + + + SUBROUTINE h5pset_fill_value_char(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + CHARACTER, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_fill_valuec_c + hdferr = h5pset_fill_valuec_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pset_fill_value_char + + + SUBROUTINE h5pget_fill_value_char(prp_id, type_id, fillvalue, & + hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + CHARACTER, INTENT(IN) :: fillvalue ! Fillvalue + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_fill_valuec_c + hdferr = h5pget_fill_valuec_c(prp_id, type_id, fillvalue) + END SUBROUTINE h5pget_fill_value_char + + SUBROUTINE h5pget_version_f(prp_id, boot, freelist, & + stab, shhdr, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, DIMENSION(:), INTENT(OUT) :: boot !array to put boot + !block version number + INTEGER, DIMENSION(:), INTENT(OUT) :: freelist !array to put global + !freelist version number + + INTEGER, DIMENSION(:), INTENT(OUT) :: stab !array to put symbol + !table version number + INTEGER, DIMENSION(:), INTENT(OUT) :: shhdr !array to put shared + !object header version number + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_version_c + hdferr = h5pget_version_c(prp_id, boot, freelist, stab, shhdr) + END SUBROUTINE h5pget_version_f + + SUBROUTINE h5pset_userblock_f (prp_id, size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: size !Size of the user-block in bytes + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_userblock_c + hdferr = h5pset_userblock_c(prp_id, size) + END SUBROUTINE h5pset_userblock_f + + + SUBROUTINE h5pget_userblock_f(prp_id, block_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), DIMENSION(:), INTENT(OUT) :: block_size !Size of the + !user-block in bytes + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_userblock_c + INTEGER :: len + hdferr = h5pget_userblock_c(prp_id, block_size) + END SUBROUTINE h5pget_userblock_f + + SUBROUTINE h5pset_sizes_f (prp_id, sizeof_addr, sizeof_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), INTENT(IN) :: sizeof_addr !Size of an object + !offset in bytes + INTEGER(SIZE_T), INTENT(IN) :: sizeof_size !Size of an object + !length in bytes + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_sizes_c + hdferr = h5pset_sizes_c(prp_id, sizeof_addr, sizeof_size) + END SUBROUTINE h5pset_sizes_f + + + SUBROUTINE h5pget_sizes_f(prp_id, sizeof_addr, sizeof_size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), DIMENSION(:), INTENT(OUT) :: sizeof_addr !Size of an object + !offset in bytes + INTEGER(SIZE_T), DIMENSION(:), INTENT(OUT) :: sizeof_size !Size of an object + !length in bytes + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_sizes_c + hdferr = h5pget_sizes_c(prp_id, sizeof_addr, sizeof_size) + END SUBROUTINE h5pget_sizes_f + + SUBROUTINE h5pset_sym_k_f (prp_id, ik, lk, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: ik ! Symbol table tree rank + INTEGER, INTENT(IN) :: lk ! Symbol table node size + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_sym_k_c + hdferr = h5pset_sym_k_c(prp_id, ik, lk) + END SUBROUTINE h5pset_sym_k_f + + + SUBROUTINE h5pget_sym_k_f(prp_id, ik, lk, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: ik !Symbol table tree rank + INTEGER, INTENT(OUT) :: lk !Symbol table node size + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_sym_k_c + hdferr = h5pget_sym_k_c(prp_id, ik, lk) + END SUBROUTINE h5pget_sym_k_f + + SUBROUTINE h5pset_istore_k_f (prp_id, ik, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: ik ! 1/2 rank of chunked storage B-tree + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_istore_k_c + hdferr = h5pset_istore_k_c(prp_id, ik) + END SUBROUTINE h5pset_istore_k_f + + + SUBROUTINE h5pget_istore_k_f(prp_id, ik, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: ik !1/2 rank of chunked storage B-tree + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_istore_k_c + hdferr = h5pget_istore_k_c(prp_id, ik) + END SUBROUTINE h5pget_istore_k_f + + SUBROUTINE h5pget_driver_f(prp_id, driver, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: driver !low-level file driver identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_driver_c + hdferr = h5pget_driver_c(prp_id, driver) + END SUBROUTINE h5pget_driver_f + + SUBROUTINE h5pset_stdio_f (prp_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_stdio_c + hdferr = h5pset_stdio_c(prp_id) + END SUBROUTINE h5pset_stdio_f + + SUBROUTINE h5pget_stdio_f (prp_id, io, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: io ! value indicates that the file + !access property list is set to + !the stdio driver + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_stdio_c + hdferr = h5pget_stdio_c(prp_id, io) + END SUBROUTINE h5pget_stdio_f + + SUBROUTINE h5pset_sec2_f (prp_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_sec2_c + hdferr = h5pset_sec2_c(prp_id) + END SUBROUTINE h5pset_sec2_f + + SUBROUTINE h5pget_sec2_f (prp_id, sec2, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: sec2 ! value indicates whether the file + !driver uses the functions declared + !in the unistd.h file + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_sec2_c + hdferr = h5pget_sec2_c(prp_id, sec2) + END SUBROUTINE h5pget_sec2_f + + SUBROUTINE h5pset_alignment_f(prp_id, threshold, alignment, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: threshold ! Threshold value + INTEGER(HSIZE_T), INTENT(IN) :: alignment ! alignment value + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_alignment_c + hdferr = h5pset_alignment_c(prp_id, threshold, alignment) + END SUBROUTINE h5pset_alignment_f + + SUBROUTINE h5pget_alignment_f(prp_id, threshold, alignment, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(OUT) :: threshold ! Threshold value + INTEGER(HSIZE_T), INTENT(OUT) :: alignment ! alignment value + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_alignment_c + hdferr = h5pget_alignment_c(prp_id, threshold, alignment) + END SUBROUTINE h5pget_alignment_f + + SUBROUTINE h5pset_core_f(prp_id, increment, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), INTENT(IN) :: increment ! File block size in bytes. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_core_c + hdferr = h5pset_core_c(prp_id, increment) + END SUBROUTINE h5pset_core_f + + SUBROUTINE h5pget_core_f(prp_id, increment, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), INTENT(OUT) :: increment ! File block size in bytes. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_core_c + hdferr = h5pget_core_c(prp_id, increment) + END SUBROUTINE h5pget_core_f + + SUBROUTINE h5pset_family_f(prp_id, memb_size, memb_plist , hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(IN) :: memb_size ! Logical size, in bytes, + !of each family member + INTEGER(HID_T), INTENT(IN) :: memb_plist !Identifier of the file + !access property list for + !each member of the family + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_family_c + hdferr = h5pset_family_c(prp_id, memb_size, memb_plist) + END SUBROUTINE h5pset_family_f + + + SUBROUTINE h5pget_family_f(prp_id, memb_size, memb_plist , hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HSIZE_T), INTENT(OUT) :: memb_size ! Logical size, in bytes, + !of each family member + INTEGER(HID_T), INTENT(OUT) :: memb_plist !Identifier of the file + !access property list for + !each member of the family + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_family_c + hdferr = h5pget_family_c(prp_id, memb_size, memb_plist) + END SUBROUTINE h5pget_family_f + + SUBROUTINE h5pset_cache_f(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: mdc_nelmts !Number of elements (objects) + ! in the meta data cache + INTEGER, INTENT(IN) :: rdcc_nelmts !Number of elements (objects) + ! in the meta data cache + INTEGER(SIZE_T), INTENT(IN) :: rdcc_nbytes !Total size of the raw data + !chunk cache, in bytes + REAL, INTENT(IN) :: rdcc_w0 !Preemption policy + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_cache_c + hdferr = h5pset_cache_c(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0 ) + END SUBROUTINE h5pset_cache_f + + SUBROUTINE h5pget_cache_f(prp_id, mdc_nelmts, rdcc_nelmts, rdcc_nbytes, rdcc_w0, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: mdc_nelmts !Number of elements (objects) + ! in the meta data cache + INTEGER, INTENT(OUT) :: rdcc_nelmts !Number of elements (objects) + ! in the meta data cache + INTEGER(SIZE_T), INTENT(OUT) :: rdcc_nbytes !Total size of the raw data + !chunk cache, in bytes + REAL, INTENT(OUT) :: rdcc_w0 !Preemption policy + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_cache_c + hdferr = h5pget_cache_c(prp_id, mdc_nelmts,rdcc_nelmts, rdcc_nbytes, rdcc_w0 ) + END SUBROUTINE h5pget_cache_f + + SUBROUTINE h5pset_split_f(prp_id, meta_ext, meta_plist, raw_ext, raw_plist, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + CHARACTER(LEN=*), INTENT(IN) :: meta_ext !Name of the extension for + !the metafile filename + INTEGER(HID_T), INTENT(IN) :: meta_plist ! Identifier of the meta file + ! access property list + CHARACTER(LEN=*), INTENT(IN) :: raw_ext !Name extension for the raw file filename + INTEGER(HID_T), INTENT(IN) :: raw_plist !Identifier of the raw file + !access property list + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: meta_len, raw_len; + + INTEGER, EXTERNAL :: h5pset_split_c + meta_len = LEN(meta_ext) + raw_len = LEN(raw_ext) + hdferr = h5pset_split_c(prp_id, meta_len, meta_ext, meta_plist, raw_len, raw_ext, raw_plist ) + END SUBROUTINE h5pset_split_f + + SUBROUTINE h5pget_split_f(prp_id, meta_ext_size, meta_ext, meta_plist,raw_ext_size,& + raw_ext, raw_plist, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(SIZE_T), INTENT(IN) :: meta_ext_size ! Number of characters of the meta + ! file extension to be copied to the + ! meta_ext buffer + + CHARACTER(LEN=*), INTENT(OUT) :: meta_ext !Name of the extension for + !the metafile filename + INTEGER(HID_T), INTENT(OUT) :: meta_plist ! Identifier of the meta file + ! access property list + INTEGER(SIZE_T), INTENT(IN) :: raw_ext_size ! Number of characters of the raw + ! file extension to be copied to the + ! raw_ext buffer + CHARACTER(LEN=*), INTENT(OUT) :: raw_ext !Name extension for the raw file filename + INTEGER(HID_T), INTENT(OUT) :: raw_plist !Identifier of the raw file + !access property list + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_split_c + hdferr = h5pget_split_c(prp_id, meta_ext_size, meta_ext, meta_plist, & + raw_ext_size, raw_ext, raw_plist ) + END SUBROUTINE h5pget_split_f + + + SUBROUTINE h5pset_gc_references_f (prp_id, gc_reference, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: gc_reference !the flag for garbage collecting + ! references for the file + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_gc_references_c + hdferr = h5pset_gc_references_c(prp_id, gc_reference) + END SUBROUTINE h5pset_gc_references_f + + SUBROUTINE h5pget_gc_references_f (prp_id, gc_reference, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: gc_reference !the flag for garbage collecting + ! references for the file + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_gc_references_c + hdferr = h5pget_gc_references_c(prp_id, gc_reference) + END SUBROUTINE h5pget_gc_references_f + + SUBROUTINE h5pset_layout_f (prp_id, layout, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: layout !Type of storage layout for raw data + !possible values are: + !H5D_COMPACT_F(0) + !H5D_CONTIGUOUS_F(1) + !H5D_CHUNKED_F(2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pset_layout_c + hdferr = h5pset_layout_c(prp_id, layout) + END SUBROUTINE h5pset_layout_f + + SUBROUTINE h5pget_layout_f (prp_id, layout, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: layout !Type of storage layout for raw data + !possible values are: + !H5D_COMPACT_F(0) + !H5D_CONTIGUOUS_F(1) + !H5D_CHUNKED_F(2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_layout_c + hdferr = h5pget_layout_c(prp_id, layout) + END SUBROUTINE h5pget_layout_f + + SUBROUTINE h5pset_filter_f(prp_id, filter, flags, cd_nelmts, cd_values, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: filter !Filter to be added to the pipeline. + INTEGER, INTENT(IN) :: flags !Bit vector specifying certain general + !properties of the filter. + INTEGER(SIZE_T), INTENT(IN) :: cd_nelmts !Number of elements in cd_values. + INTEGER, DIMENSION(*), INTENT(IN) :: cd_values !Auxiliary data for the filter. + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_filter_c + hdferr = h5pset_filter_c(prp_id, filter, flags, cd_nelmts, cd_values ) + END SUBROUTINE h5pset_filter_f + + SUBROUTINE h5pget_nfilters_f (prp_id, nfilters, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: nfilters !the number of filters in the pipeline + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_nfilters_c + hdferr = h5pget_nfilters_c(prp_id, nfilters) + END SUBROUTINE h5pget_nfilters_f + + SUBROUTINE h5pget_filter_f(prp_id, filter_number, flags, cd_nelmts, cd_values, namelen, name, filter_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: filter_number !Sequence number within the filter + !pipeline of the filter for which + !information is sought + INTEGER, DIMENSION(*), INTENT(OUT) :: cd_values !Auxiliary data for the filter. + INTEGER, INTENT(OUT) :: flags !Bit vector specifying certain general + !properties of the filter. + INTEGER(SIZE_T), INTENT(INOUT) :: cd_nelmts !Number of elements in cd_values. + INTEGER(SIZE_T), INTENT(IN) :: namelen !Anticipated number of characters in name. + CHARACTER(LEN=*), INTENT(OUT) :: name !Name of the filter + INTEGER, INTENT(OUT) :: filter_id ! filter identification number + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_filter_c + hdferr = h5pget_filter_c(prp_id, filter_number, flags, cd_nelmts, & + cd_values, namelen, name, filter_id ) + END SUBROUTINE h5pget_filter_f + + SUBROUTINE h5pset_external_f(prp_id, name, offset,bytes, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of an external file + INTEGER, INTENT(IN) :: offset !Offset, in bytes, from the beginning + !of the file to the location in the file + !where the data starts. + INTEGER(HSIZE_T), INTENT(IN) :: bytes ! Number of bytes reserved in the + !file for the data + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_external_c + INTEGER :: namelen + namelen = LEN(name) + + hdferr = h5pset_external_c(prp_id, name,namelen, offset, bytes) + END SUBROUTINE h5pset_external_f + + SUBROUTINE h5pget_external_count_f (prp_id, count, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: count !number of external files for the + !specified dataset + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5pget_external_count_c + hdferr = h5pget_external_count_c(prp_id, count) + END SUBROUTINE h5pget_external_count_f + + + SUBROUTINE h5pget_external_f(prp_id, idx, name_size, name, offset,bytes, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: idx !External file index. + INTEGER(SIZE_T), INTENT(IN) :: name_size !Maximum length of name array + CHARACTER(LEN=*), INTENT(OUT) :: name !Name of an external file + INTEGER, INTENT(OUT) :: offset !Offset, in bytes, from the beginning + !of the file to the location in the file + !where the data starts. + INTEGER(HSIZE_T), INTENT(OUT) :: bytes ! Number of bytes reserved in the + !file for the data + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_external_c + + hdferr = h5pget_external_c(prp_id, idx, name_size, name, offset, bytes) + END SUBROUTINE h5pget_external_f + + SUBROUTINE h5pset_hyper_cache_f(prp_id, cache, limit, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: cache ! + INTEGER, INTENT(IN) :: limit ! Maximum size of the hyperslab block to + !cache. 0 (zero) indicates no limit. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_hyper_cache_c + hdferr = h5pset_hyper_cache_c(prp_id, cache, limit) + END SUBROUTINE h5pset_hyper_cache_f + + SUBROUTINE h5pget_hyper_cache_f(prp_id, cache, limit, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: cache ! + INTEGER, INTENT(OUT) :: limit ! Maximum size of the hyperslab block to + !cache. 0 (zero) indicates no limit. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_hyper_cache_c + hdferr = h5pget_hyper_cache_c(prp_id, cache, limit) + END SUBROUTINE h5pget_hyper_cache_f + + SUBROUTINE h5pset_btree_ratios_f(prp_id, left, middle, right, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + REAL, INTENT(IN) :: left !The B-tree split ratio for left-most nodes. + REAL, INTENT(IN) :: middle !The B-tree split ratio for all other nodes + REAL, INTENT(IN) :: right !The B-tree split ratio for right-most + !nodes and lone nodes. + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_btree_ratios_c + hdferr = h5pset_btree_ratios_c(prp_id, left, middle, right) + END SUBROUTINE h5pset_btree_ratios_f + + SUBROUTINE h5pget_btree_ratios_f(prp_id, left, middle, right, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + REAL, INTENT(OUT) :: left !The B-tree split ratio for left-most nodes. + REAL, INTENT(OUT) :: middle !The B-tree split ratio for all other nodes + REAL, INTENT(OUT) :: right !The B-tree split ratio for right-most + !nodes and lone nodes. + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_btree_ratios_c + hdferr = h5pget_btree_ratios_c(prp_id, left, middle, right) + END SUBROUTINE h5pget_btree_ratios_f + + END MODULE H5P diff --git a/fortran/src/H5Pff_parallel.f90 b/fortran/src/H5Pff_parallel.f90 new file mode 100644 index 0000000..488b7a0 --- /dev/null +++ b/fortran/src/H5Pff_parallel.f90 @@ -0,0 +1,59 @@ +! +! This file contains Fortran90 interfaces for H5P functions needed by || MPI programs. +! + MODULE H5P_parallel + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + CONTAINS + SUBROUTINE h5pset_mpi_f(prp_id, comm, info, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: comm ! MPI communicator to be used for file open + ! as defined in MPI_FILE_OPEN of MPI-2 + INTEGER, INTENT(IN) :: info ! MPI info object to be used for file open + ! as defined in MPI_FILE_OPEN of MPI-2 + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_mpi_c + hdferr = h5pset_mpi_c(prp_id, comm, info) + END SUBROUTINE h5pset_mpi_f + + SUBROUTINE h5pget_mpi_f(prp_id, comm, info, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: comm ! buffer to return communicator + INTEGER, INTENT(IN) :: info ! buffer to return info object + ! as defined in MPI_FILE_OPEN of MPI-2 + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_mpi_c + hdferr = h5pget_mpi_c(prp_id, comm, info) + END SUBROUTINE h5pget_mpi_f + + SUBROUTINE h5pset_xfer_f(prp_id, data_xfer_mode, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(IN) :: data_xfer_mode ! Data transfer mode. Possible values are: + ! H5D_XFER_INDEPENDENT_F (0) + ! H5D_XFER_COLLECTIVE_F (1) + ! H5D_XFER_DFLT_F (2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pset_xfer_c + hdferr = h5pset_xfer_c(prp_id, data_xfer_mode) + END SUBROUTINE h5pset_xfer_f + + SUBROUTINE h5pget_xfer_f(prp_id, data_xfer_mode, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER, INTENT(OUT) :: data_xfer_mode ! Data transfer mode. Possible values are: + ! H5D_XFER_INDEPENDENT_F (0) + ! H5D_XFER_COLLECTIVE_F (1) + ! H5D_XFER_DFLT_F (2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5pget_xfer_c + hdferr = h5pget_xfer_c(prp_id, data_xfer_mode) + END SUBROUTINE h5pget_xfer_f + + END MODULE H5P_parallel diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c new file mode 100644 index 0000000..16e0f4a --- /dev/null +++ b/fortran/src/H5Rf.c @@ -0,0 +1,267 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5rcreate_object_c + * Purpose: Call H5Rcreate to create a reference to an object + * Inputs: loc_id - file or group identifier + * name - name of the dataset + * namelen - name length + * Outputs: ref - reference to the object + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rcreate_object_c (_fcd ref, hid_t_f *loc_id, _fcd name, int_f *namelen) +{ + int ret_value = -1; + hid_t c_loc_id; + int ret_value_c; + char *c_name; + int c_namelen; + hobj_ref_t ref_c; + int i; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Rcreate function. + */ + c_loc_id = *loc_id; + ret_value_c = H5Rcreate(&ref_c, c_loc_id, c_name, H5R_OBJECT, -1); + HDfree(c_name); + if (ret_value_c >= 0) { + for(i=0; i < H5R_OBJ_REF_BUF_SIZE; i++) + { +#if defined(_UNICOS) + ref.c_pointer[i]=ref_c.oid[i]; +#else + ref[i]=ref_c.oid[i]; +#endif + } + ret_value = 0; + } + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5rcreate_region_c + * Purpose: Call H5Rcreate to create a reference to dataset region + * region + * Inputs: loc_id - file or group identifier + * name - name of the dataset + * namelen - name length + * space_id - dataset space identifier + * Outputs: ref - reference to the dataset region + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rcreate_region_c (_fcd ref, hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *space_id) +{ + int ret_value = -1; + hid_t c_loc_id; + hid_t c_space_id; + int ret_value_c; + char *c_name; + int c_namelen; + hdset_reg_ref_t ref_c; + int i; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Rcreate function. + */ + c_loc_id = *loc_id; + c_space_id = *space_id; + ret_value_c = H5Rcreate(&ref_c, c_loc_id, c_name, H5R_DATASET_REGION, c_space_id); + HDfree(c_name); + if (ret_value_c >= 0) { + for(i=0; i < H5R_DSET_REG_REF_BUF_SIZE; i++) + { +#if defined(_UNICOS) + ref.c_pointer[i]=ref_c.heapid[i]; +#else + ref[i]=ref_c.heapid[i]; +#endif + } + ret_value = 0; + } + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5rdereference_region_c + * Purpose: Call H5Rdereference to dereference to dataset region + * Inputs: dset_id - dataset identifier + * ref - reference to the dataset region + * Outputs: obj_id - dereferenced dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rdereference_region_c (hid_t_f *dset_id, _fcd ref, hid_t_f *obj_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hdset_reg_ref_t ref_c; + hid_t c_obj_id; + int i; + + for(i=0; i < H5R_DSET_REG_REF_BUF_SIZE; i++) { + +#if defined(_UNICOS) + ref_c.heapid[i]=ref.c_pointer[i]; +#else + ref_c.heapid[i]=ref[i]; +#endif + } + + /* + * Call H5Rdereference function. + */ + c_dset_id = *dset_id; + c_obj_id = H5Rdereference(c_dset_id, H5R_DATASET_REGION, &ref_c); + if(c_obj_id < 0) return ret_value; + *obj_id = (hid_t_f)c_obj_id; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5rdereference_object_c + * Purpose: Call H5Rdereference to dereference an object + * Inputs: dset_id - dataset identifier + * ref - reference to an object + * Outputs: obj_id - dereferenced object identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rdereference_object_c (hid_t_f *dset_id, _fcd ref, hid_t_f *obj_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hid_t c_obj_id; + hobj_ref_t ref_c; + int i; + + for(i=0; i < H5R_OBJ_REF_BUF_SIZE; i++) { + +#if defined(_UNICOS) + ref_c.oid[i]=ref.c_pointer[i]; +#else + ref_c.oid[i]=ref[i]; +#endif + } + + /* + * Call H5Rdereference function. + */ + c_dset_id = *dset_id; + c_obj_id = H5Rdereference(c_dset_id, H5R_OBJECT, &ref_c); + if(c_obj_id < 0) return ret_value; + *obj_id = (hid_t_f)c_obj_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5rget_region_region_object_c + * Purpose: Call H5Rget_region to dereference dataspace region + * Inputs: dset_id - dataset identifier + * ref - reference to the dataset region + * Outputs: space_id - dereferenced dataset dataspace identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rget_region_region_c (hid_t_f *dset_id, _fcd ref, hid_t_f *space_id) +{ + int ret_value = -1; + hid_t c_dset_id; + hid_t c_space_id; + hdset_reg_ref_t ref_c; + int i; + + for(i=0; i < H5R_DSET_REG_REF_BUF_SIZE; i++) { + +#if defined(_UNICOS) + ref_c.heapid[i]=ref.c_pointer[i]; +#else + ref_c.heapid[i]=ref[i]; +#endif + } + + /* + * Call H5Rget_region function. + */ + c_dset_id = *dset_id; + c_space_id = H5Rget_region(c_dset_id, H5R_DATASET_REGION, &ref_c); + if(c_space_id < 0) return ret_value; + *space_id = (hid_t_f)c_space_id; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5rget_object_type_obj_c + * Purpose: Call H5Rget_object_type to retrieve the type of the object reference points + * to + * Inputs: dset_id - dataset identifier + * ref - reference to the dataset region + * Outputs: obj_type - type of dereferenced object + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, December 1, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rget_object_type_obj_c (hid_t_f *dset_id, _fcd ref, int_f *obj_type) +{ + int ret_value = -1; + hid_t c_dset_id; + int c_obj_type; + hobj_ref_t ref_c; + int i; + + for(i=0; i < H5R_OBJ_REF_BUF_SIZE; i++) { + +#if defined(_UNICOS) + ref_c.oid[i]=ref.c_pointer[i]; +#else + ref_c.oid[i]=ref[i]; +#endif + } + + /* + * Call H5Rget_object_type function. + */ + c_dset_id = *dset_id; + c_obj_type = H5Rget_object_type(c_dset_id, &ref_c); + if(c_obj_type < 0) return ret_value; + *obj_type = (int_f)c_obj_type; + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Rff.f90 b/fortran/src/H5Rff.f90 new file mode 100644 index 0000000..3fd9142 --- /dev/null +++ b/fortran/src/H5Rff.f90 @@ -0,0 +1,138 @@ +! +! This file contains Fortran90 interfaces for H5R functions. +! + MODULE H5R + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + TYPE hobj_ref_t_f + !INTEGER(KIND=4) ref(2) could cause trouble on Crays + CHARACTER ref(8) + END TYPE + + TYPE hdset_reg_ref_t_f + !INTEGER(KIND=4) reg_ref(3) could cause troubles on Crays + CHARACTER ref(12) + END TYPE + + INTERFACE h5rcreate_f + + MODULE PROCEDURE h5rcreate_object_f + MODULE PROCEDURE h5rcreate_region_f + + END INTERFACE + + INTERFACE h5rdereference_f + + MODULE PROCEDURE h5rdereference_object_f + MODULE PROCEDURE h5rdereference_region_f + + END INTERFACE + + INTERFACE h5rget_region_f + + MODULE PROCEDURE h5rget_region_region_f + + END INTERFACE + + INTERFACE h5rget_object_type_f + + MODULE PROCEDURE h5rget_object_type_obj_f + + END INTERFACE + + + CONTAINS + + + SUBROUTINE h5rcreate_object_f(loc_id, name, ref, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the object at location specified + ! by loc_id identifier + TYPE(hobj_ref_t_f), INTENT(OUT) :: ref ! Object reference + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5rcreate_object_c + namelen = LEN(name) + hdferr = h5rcreate_object_c(ref, loc_id, name, namelen ) + + END SUBROUTINE h5rcreate_object_f + + SUBROUTINE h5rcreate_region_f(loc_id, name, space_id, ref, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified + ! by loc_id identifier + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataset's dataspace identifier + TYPE(hdset_reg_ref_t_f), INTENT(OUT) :: ref ! Dataset region reference + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5rcreate_region_c + namelen = LEN(name) + hdferr = h5rcreate_region_c(ref, loc_id, name, namelen, space_id ) + + END SUBROUTINE h5rcreate_region_f + + SUBROUTINE h5rdereference_object_f(dset_id, ref, obj_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hobj_ref_t_f), INTENT(IN) :: ref ! Object reference + INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: ref_type ! Reference type + INTEGER, EXTERNAL :: h5rdereference_object_c + ref_type = H5R_OBJECT_F + hdferr = h5rdereference_object_c(dset_id, ref, obj_id ) + + END SUBROUTINE h5rdereference_object_f + + SUBROUTINE h5rdereference_region_f(dset_id, ref, obj_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Object reference + INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: ref_type ! Reference type + INTEGER, EXTERNAL :: h5rdereference_region_c + ref_type = H5R_DATASET_REGION_F + hdferr = h5rdereference_region_c(dset_id, ref, obj_id ) + + END SUBROUTINE h5rdereference_region_f + + + SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference + INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5rget_region_region_c + hdferr = h5rget_region_region_c(dset_id, ref, space_id ) + + END SUBROUTINE h5rget_region_region_f + + SUBROUTINE h5rget_object_type_obj_f(dset_id, ref, obj_type, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier + TYPE(hobj_ref_t_f), INTENT(IN) :: ref ! Object reference + INTEGER, INTENT(OUT) :: obj_type ! Object type + ! H5G_UNKNOWN_F (-1) + ! H5G_LINK_F 0 + ! H5G_GROUP_F 1 + ! H5G_DATASET_F 2 + ! H5G_TYPE_F 3 + + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5rget_object_type_obj_c + hdferr = h5rget_object_type_obj_c(dset_id, ref, obj_type ) + + END SUBROUTINE h5rget_object_type_obj_f + + END MODULE H5R diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c new file mode 100644 index 0000000..af9c4a5 --- /dev/null +++ b/fortran/src/H5Sf.c @@ -0,0 +1,874 @@ +#include "H5f90.h" + +/*---------------------------------------------------------------------------- + * Name: h5screate_simple_c + * Purpose: Call H5Screate_simple to create a dataspace + * Inputs: rank - number of dimensions of dataspace + * dims - array of the size of each dimension + maxdims - an array of the maximum size of each dimension + * Outputs: space_id - identifier of the created dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 4, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5screate_simple_c ( int_f *rank, hsize_t_f *dims, hsize_t_f *maxdims, hid_t_f *space_id ) +{ + int ret_value = -1; + hsize_t *c_dims; + hsize_t *c_maxdims; + hid_t c_space_id; + int i; + + c_dims = malloc(sizeof(hsize_t) * (*rank )); + if (!c_dims) return ret_value; + c_maxdims = malloc(sizeof(hsize_t) * (*rank )); + if (!c_maxdims) return ret_value; + + /* + * Transpose dimension arrays because of C-FORTRAN storage order + */ + for (i = 0; i < *rank ; i++) { + c_dims[i] = dims[*rank - i - 1]; + c_maxdims[i] = maxdims[*rank - i - 1]; + } + + c_space_id = H5Screate_simple(*rank, c_dims, c_maxdims); + if (c_space_id < 0) return ret_value; + + *space_id = (hid_t_f)c_space_id; + ret_value = 0; + HDfree (c_dims); + HDfree (c_maxdims); + return ret_value; +} + + + +/*---------------------------------------------------------------------------- + * Name: h5sclose_c + * Purpose: Call H5Sclose to close the dataspace + * Inputs: space_id - identifier of the dataspace to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 4, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sclose_c ( hid_t_f *space_id ) +{ + int ret_value = 0; + hid_t c_space_id; + + c_space_id = *space_id; + if ( H5Sclose(c_space_id) < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5screate_c + * Purpose: Call H5Screate to create a dataspace + * Inputs: classtype - type of the dataspace class + * Outputs: space_id - identifier of the created dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 10, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5screate_c ( int_f *classtype, hid_t_f *space_id ) +{ + H5S_class_t c_classtype; + int CASE; + int ret_value = 0; + hid_t c_space_id; + CASE = (int)*classtype; + + switch (CASE) { + + case (H5S_SCALAR_F): + c_classtype = H5S_SCALAR; + break; + + case(H5S_SIMPLE_F): + c_classtype = H5S_SIMPLE; + break; + + default: + ret_value = -1; + return ret_value; + } + c_space_id = H5Screate(c_classtype); + + if ( c_space_id < 0 ) ret_value = -1; + *space_id = (hid_t_f) c_space_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5scopy_c + * Purpose: Call H5Scopy to copy dataspace + * Inputs: space_id - identifier of the dataspace to be copied + * Outputs: new_space_id - identifier of the new datspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 10, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5scopy_c( hid_t_f *space_id , hid_t_f *new_space_id) +{ + int ret_value = 0; + hid_t c_new_space_id; + hid_t c_space_id; + + c_space_id = *space_id; + c_new_space_id = H5Scopy(c_space_id); + if ( c_new_space_id < 0 ) ret_value = -1; + + *new_space_id = (hid_t_f)c_new_space_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_hyper_nblocks_c + * Purpose: Call H5SH5Sget_select_hyper_nblocks to + * get the the number of hyperslab blocks in + * the current dataspace selection if successful + * Inputs: space_id - identifier of the dataspace + * Outputs: num_blocks - number of hyperslab blocks in + * the current dataspace selection + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, November 12, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_hyper_nblocks_c( hid_t_f *space_id , hssize_t_f * num_blocks) +{ + int ret_value = 0; + hid_t c_space_id; + hssize_t c_num_blocks; + hsize_t* buf; + int i, j; + + c_space_id = *space_id; + c_num_blocks = H5Sget_select_hyper_nblocks(c_space_id); + if ( c_num_blocks < 0 ) ret_value = -1; + + *num_blocks = (hssize_t_f)c_num_blocks; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_elem_npoints_c + * Purpose: Call H5Sget_select_elem_npoints to + * get the the number of element points in + * the current dataspace selection if successful + * Inputs: space_id - identifier of the dataspace + * Outputs: num_points - number of element points in + * the current dataspace selection + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Monday, November 15, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_elem_npoints_c( hid_t_f *space_id , hssize_t_f * num_points) +{ + int ret_value = 0; + hid_t c_space_id; + hssize_t c_num_points; + + c_space_id = *space_id; + c_num_points = H5Sget_select_elem_npoints(c_space_id); + if ( c_num_points < 0 ) ret_value = -1; + + *num_points = (hssize_t_f)c_num_points; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_hyper_blocklist_c + * Purpose: Call H5Sget_select_hyper_blocklist to + * get a list of the hyperslab blocks currently selected + * Starting with the startblock-th block in the + * list of blocks, num_blocks blocks are put into the user's + * buffer. If the user's buffer fills up before numblocks + * blocks are inserted, the buffer + * will contain only as many blocks as fit. + * Inputs: space_id - identifier of the dataspace + * startblock - Hyperslab block to start with + * num_blocks - number of hyperslab blocks in + * the current dataspace selection + * Outputs: buf - List of hyperslab blocks selected + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Monday, November 15, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_hyper_blocklist_c( hid_t_f *space_id ,hsize_t_f * startblock, + hsize_t_f * num_blocks, hsize_t_f * buf) +{ + int ret_value = -1; + hid_t c_space_id; + hsize_t c_num_blocks; + + int i, rank; + hsize_t* c_startblock,* c_buf; + + c_space_id = *space_id; + c_num_blocks = * num_blocks; + + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0 ) return ret_value; + + c_startblock = (hsize_t*)malloc(sizeof(hsize_t)*rank); + if (!c_startblock) return ret_value; + for (i = 0; i < rank; i++) + { + c_startblock[i] = (hsize_t)startblock[i]; + } + + c_buf = (hsize_t*)malloc(sizeof(hsize_t)*c_num_blocks*2*rank); + if (!c_buf) return ret_value; + + ret_value = H5Sget_select_hyper_blocklist(c_space_id, *c_startblock, + c_num_blocks, c_buf); + for(i = 0; i < c_num_blocks*2*rank; i++) + { + buf[i] = (hsize_t_f)c_buf[i] +1; + } + HDfree(c_buf); + HDfree(c_startblock); + if (ret_value >= 0 ) ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_bounds_c + * Purpose: Call H5Sget_select_bounds to retrieve the coordinates + * of the bounding box containing the current selection + * and places them into user-supplied buffers + * Inputs: space_id - identifier of the dataspace + * Outputs: start - Starting coordinates of the bounding box + * end - Ending coordinates of the bounding box, + * i.e., the coordinates of the diagonally opposite corne + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, November 17, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_bounds_c( hid_t_f *space_id , hsize_t_f * start, hsize_t_f * end) +{ + int ret_value = -1; + hid_t c_space_id; + hsize_t* c_start, *c_end; + int i, rank; + + c_space_id = *space_id; + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0 ) return ret_value; + + c_start =(hsize_t*) malloc(sizeof(hsize_t)*rank); + if (!c_start) return ret_value; + + c_end = (hsize_t*)malloc(sizeof(hsize_t)*rank); + if(!c_end) return ret_value; + + ret_value = H5Sget_select_bounds(c_space_id, c_start, c_end); + for(i = 0; i < rank; i++) + { + start[i] = (hsize_t_f)(c_start[i]+1); + end[i] = (hsize_t_f)(c_end[i]+1); + } + if (ret_value >= 0 ) ret_value = 0; + + HDfree(c_start); + HDfree(c_end); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_elem_pointlist_c + * Purpose: Call H5Sget_select_elem_pointlist + * get a list of element points in the + * current dataspace selectin. + * Starting with the startpoint-th point in the + * list of points, numpoints points are put into the user's + * buffer. If the user's buffer fills up before numpoints + * points are inserted, the buffer + * will contain only as many points as fit. + * Inputs: space_id - identifier of the dataspace + * startpoint - Element point to start with + * numpoints - Number of element points to get + * Outputs: buf - List of element points selected + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Wednesday, November 17, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, + hsize_t_f * numpoints, hsize_t_f * buf) +{ + int ret_value = -1; + hid_t c_space_id; + hsize_t c_num_points; + hsize_t* c_startpoint,* c_buf; + int i,j, rank; + + c_space_id = *space_id; + c_num_points = (hsize_t)* numpoints; + + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0 ) return ret_value; + + c_startpoint = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + if (!c_startpoint) return ret_value; + for (i =0; i < rank; i++) + c_startpoint[i] = (hsize_t)startpoint[i]; + + c_buf = (hsize_t*)malloc(sizeof(hsize_t)*c_num_points*rank); + if (!c_buf) return ret_value; + ret_value = H5Sget_select_elem_pointlist(c_space_id, *startpoint, + c_num_points, c_buf); + for (i = c_num_points*rank-1; i >= 0; i--) { + buf[i] = (hsize_t_f)(c_buf[i]+1); + } + + if (ret_value >= 0 ) ret_value = 0; + + HDfree(c_startpoint); + HDfree(c_buf); + + return ret_value; +} + + + +/*---------------------------------------------------------------------------- + * Name: h5sselect_all_c + * Purpose: Call H5Sselect_all to select entire dataspace + * Inputs: space_id - identifier of the dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 10, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sselect_all_c ( hid_t_f *space_id ) +{ + int ret_value = 0; + hid_t c_space_id; + + c_space_id = *space_id; + if ( H5Sselect_all(c_space_id) < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sselect_none_c + * Purpose: Call H5Sselect_none to reset the selection region + * Inputs: space_id - identifier of the dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 10, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sselect_none_c ( hid_t_f *space_id ) +{ + int ret_value = 0; + hid_t c_space_id; + + c_space_id = *space_id; + if ( H5Sselect_none(c_space_id) < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sselect_valid_c + * Purpose: Call H5Sselect_valid to verify that selection + * is within dataspace extent. + * Inputs: space_id - identifier of the dataspace + * Outputs: flag - 0 if not valid selection, 1 if is valid selection, + * and negative on failure. + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 10, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sselect_valid_c ( hid_t_f *space_id , int_f *flag ) +{ + int ret_value = 0; + hid_t c_space_id; + htri_t status; + + c_space_id = *space_id; + status = H5Sselect_valid(c_space_id); + *flag = (int_f)status; + if ( status < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_simple_extent_npoints_c + * Purpose: Call H5Sget_simple_extent_npoints to determine the number + * of elements in a dataspace + * Inputs: space_id - identifier of the dataspace + * Outputs: npoints - number of points in a dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_simple_extent_npoints_c ( hid_t_f *space_id , hsize_t_f *npoints ) +{ + int ret_value = 0; + hid_t c_space_id; + hsize_t c_npoints; + + c_space_id = *space_id; + c_npoints = H5Sget_simple_extent_npoints(c_space_id); + if ( c_npoints == 0 ) ret_value = -1; + *npoints = (hsize_t_f)c_npoints; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_select_npoints_c + * Purpose: Call H5Sget_select_npoints to determine the number + * of elements in a dataspace selection + * Inputs: space_id - identifier of the dataspace + * Outputs: npoints - number of points in a dataspace selection + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_select_npoints_c ( hid_t_f *space_id , hssize_t_f *npoints ) +{ + int ret_value = 0; + hssize_t c_npoints; + hid_t c_space_id; + + c_space_id = *space_id; + c_npoints = H5Sget_select_npoints(c_space_id); + if ( c_npoints == 0 ) ret_value = -1; + *npoints = (hssize_t_f)c_npoints; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_simple_extent_ndims_c + * Purpose: Call H5Sget_simple_extent_ndims to determine the number + * dimensions + * Inputs: space_id - identifier of the dataspace + * Outputs: rank - number of dataspace dimensions + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_simple_extent_ndims_c ( hid_t_f *space_id , int_f *ndims ) +{ + int ret_value = 0; + hid_t c_space_id; + int c_ndims; + + c_space_id = *space_id; + c_ndims = H5Sget_simple_extent_ndims(c_space_id); + if ( c_ndims < 0 ) ret_value = -1; + *ndims = (int_f)c_ndims; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_simple_extent_type_c + * Purpose: Call H5Sget_simple_extent_type to determine the class type + * of a dataspace + * Inputs: space_id - identifier of the dataspace + * Outputs: classtype - class type; possible values are: + * H5S_SCALAR_F (0), H5S_SIMPLE_F (1) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_simple_extent_type_c ( hid_t_f *space_id , int_f *classtype) +{ + int ret_value = 0; + hid_t c_space_id; + H5S_class_t c_classtype; + + c_space_id = *space_id; + c_classtype = H5Sget_simple_extent_type(c_space_id); + if ( c_classtype < 0 ) ret_value = -1; + if (c_classtype == H5S_SCALAR) *classtype = H5S_SCALAR_F; + if (c_classtype == H5S_SIMPLE) *classtype = H5S_SIMPLE_F; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5soffset_simple_c + * Purpose: Call H5Soffset_simple to set the offset of a simple + * dataspace + * Inputs: space_id - identifier of the dataspace + * offset - offset array + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5soffset_simple_c ( hid_t_f *space_id , hssize_t_f *offset) +{ + int ret_value = -1; + hid_t c_space_id; + int rank; + hssize_t *c_offset; + herr_t status; + int i; + + c_space_id = *space_id; + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0) return ret_value; + + c_offset = malloc(sizeof(hssize_t)*rank); + if (!c_offset) return ret_value; + + /* + * Reverse dimensions due to C-FORTRAN storage order. + */ + for (i=0; i < rank; i++) c_offset[i] = offset[rank - i - 1]; + + status = H5Soffset_simple(c_space_id, c_offset); + if ( status >= 0 ) ret_value = 0; + HDfree(c_offset); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sset_extent_simple_c + * Purpose: Call H5Sset_extent_simple to set or reset size of + * existing dataspace + * Inputs: space_id - identifier of the dataspace + * rank - dataspace rank + * current_size - array with the new dimension sizes + * maximum_size - aray with maximum sizes of dimensions + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sset_extent_simple_c ( hid_t_f *space_id , int_f *rank, hsize_t_f *current_size, hsize_t_f *maximum_size) +{ + int ret_value = -1; + hid_t c_space_id; + int c_rank; + hsize_t *c_current_size; + hsize_t *c_maximum_size; + herr_t status; + int i; + + c_current_size = malloc(sizeof(hsize_t)*(*rank)); + if (!c_current_size) return ret_value; + + c_maximum_size = malloc(sizeof(hsize_t)*(*rank)); + if (!c_maximum_size) return ret_value; + + /* + * Reverse dimensions due to C-FORTRAN storage order. + */ + for (i=0; i < *rank; i++) { + c_current_size[i] = (hsize_t)current_size[*rank - i - 1]; + c_maximum_size[i] = (hsize_t)maximum_size[*rank - i - 1]; + } + + c_space_id = *space_id; + c_rank = *rank; + status = H5Sset_extent_simple(c_space_id, c_rank, c_current_size, c_maximum_size); + if ( status >= 0 ) ret_value = 0; + HDfree(c_current_size); + HDfree(c_maximum_size); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sget_simple_extent_dims_c + * Purpose: Call H5Sget_simple_extent_dims to retrieve sizes of an + * existing dataspace + * Inputs: space_id - identifier of the dataspace + * Outputs: dims - array with the dimension sizes + * maxdims - aray with maximum sizes of dimensions + * Returns: number of dataspace dimensions (rank) on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sget_simple_extent_dims_c ( hid_t_f *space_id , hsize_t_f *dims, hsize_t_f *maxdims) +{ + int ret_value = -1; + hid_t c_space_id; + hsize_t *c_dims; + hsize_t *c_maxdims; + int status; + int rank; + int i; + + c_space_id = *space_id; + rank = H5Sget_simple_extent_ndims(c_space_id); + if (rank < 0) return ret_value; + + c_dims = malloc(sizeof(hsize_t)*rank); + if (!c_dims) return ret_value; + + c_maxdims = malloc(sizeof(hsize_t)*rank); + if (!c_maxdims) return ret_value; + + status = H5Sget_simple_extent_dims(c_space_id, c_dims, c_maxdims); + /* + * Reverse dimensions due to C-FORTRAN storage order. + */ + for (i=0; i < rank; i++) { + dims[rank - i - 1] = (hsize_t_f)c_dims[i]; + maxdims[rank - i - 1] = (hsize_t_f)c_maxdims[i]; + } + + if ( status >= 0 ) ret_value = rank; + HDfree(c_dims); + HDfree(c_maxdims); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sis_simple_c + * Purpose: Call H5Sis_simple to detrmine if the dataspace + * is simple. + * Inputs: space_id - identifier of the dataspace + * Outputs: flag - 0 if not simple, 1 if is simple, + * and negative on failure. + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sis_simple_c ( hid_t_f *space_id , int_f *flag ) +{ + int ret_value = 0; + hid_t c_space_id; + htri_t status; + + c_space_id = *space_id; + status = H5Sis_simple(c_space_id); + *flag = (int_f)status; + if ( status < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5sextent_copy_c + * Purpose: Call H5Sextent_copy to copy an extent of dataspace + * Inputs: dest_space_id - identifier of the destination dataspace + * source_space_id - identifier of the source dataspace + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sextent_copy_c ( hid_t_f *dest_space_id , hid_t_f *source_space_id) +{ + int ret_value = 0; + hid_t c_dest_space_id, c_source_space_id; + herr_t status; + + c_dest_space_id = *dest_space_id; + c_source_space_id = *source_space_id; + status = H5Sextent_copy(c_dest_space_id, c_source_space_id); + if ( status < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sset_extent_none_c + * Purpose: Call H5Sset_extent_none to remove extent from a dataspace + * Inputs: space_id - dataspace identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sset_extent_none_c ( hid_t_f *space_id ) +{ + int ret_value = 0; + hid_t c_space_id; + herr_t status; + + c_space_id = *space_id; + status = H5Sset_extent_none(c_space_id); + if ( status < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sselect_hyperslab_c + * Purpose: Call H5Sselect_hyperslab to select a hyperslab + * Inputs: space_id - identifier of the dataspace + * operator - defines how the new selection is combined + * with the previous one; current values are + * H5S_SELECT_SET_F (0) and H5S_SELECT_OR_F (1) + * start - offset of start of hyperslab + * count - number of blocks included in the hyperslab + * stride - hyperslab stride (interval between blocks) + * block - size of block in the hyperslab + * maximum_size - aray with maximum sizes of dimensions + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sselect_hyperslab_c ( hid_t_f *space_id , int_f *op, hssize_t_f *start, hsize_t_f *count, hsize_t_f *stride, hsize_t_f *block) +{ + int ret_value = -1; + hid_t c_space_id; + hssize_t *c_start; + hsize_t *c_count; + hsize_t *c_stride; + hsize_t *c_block; + + H5S_seloper_t c_op; + herr_t status; + int rank; + int i; + + rank = H5Sget_simple_extent_ndims(*space_id); + if (rank < 0 ) return ret_value; + c_start = (hssize_t *)HDmalloc(sizeof(hssize_t)*rank); + if (!c_start) return ret_value; + + c_count = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + if (!c_count) return ret_value; + + c_stride = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + if (!c_stride) return ret_value; + + c_block = (hsize_t *)HDmalloc(sizeof(hsize_t)*rank); + if (!c_block) return ret_value; + + + /* + * Reverse dimensions due to C-FORTRAN storage order. + */ + + for (i=0; i < rank; i++) { + int t= (rank - i) - 1; + c_start[i] = (hssize_t)start[t]; + c_count[i] = (hsize_t)count[t]; + c_stride[i] = (hsize_t)stride[t]; + c_block[i] = (hsize_t)block[t]; + } + + if (*op == H5S_SELECT_SET_F) c_op = H5S_SELECT_SET; + if (*op == H5S_SELECT_OR_F) c_op = H5S_SELECT_OR; + + + c_space_id = *space_id; + status = H5Sselect_hyperslab(c_space_id, c_op, c_start, c_stride, c_count, c_block); + if ( status >= 0 ) ret_value = 0; + HDfree(c_start); + HDfree(c_count); + HDfree(c_stride); + HDfree(c_block); + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5sselect_elements_c + * Purpose: Call H5Sselect_elements to select elements of a dataspace + * Inputs: space_id - identifier of the dataspace + * operator - defines how the new selection is combined + * with the previous one; current values are + * H5S_SELECT_SET_F (0) + * nelements - number of elements in the selection + * coord - arrays with the elements coordinates + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Wednesday, August 11, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hssize_t_f *coord) +{ + int ret_value = -1; + hid_t c_space_id; + H5S_seloper_t c_op; + herr_t status; + int rank; + int i, j; + hssize_t *c_coord; + size_t c_nelements; + + if (*op != H5S_SELECT_SET_F) return ret_value; + c_op = H5S_SELECT_SET; + + c_space_id = *space_id; + rank = H5Sget_simple_extent_ndims(c_space_id); + + c_coord = malloc(sizeof(hssize_t)*rank*(*nelements)); + if(!c_coord) return ret_value; + for (i=0; i< *nelements; i++) { + for (j = 0; j < rank; j++) { + c_coord[j+i*rank] = (hssize_t)coord[j + i*rank]; + } + } + + c_nelements = *nelements; + status = H5Sselect_elements(c_space_id, c_op, c_nelements, (const hssize_t **)c_coord); + if ( status >= 0 ) ret_value = 0; + HDfree(c_coord); + return ret_value; +} + diff --git a/fortran/src/H5Sff.f90 b/fortran/src/H5Sff.f90 new file mode 100644 index 0000000..d4b6b2f --- /dev/null +++ b/fortran/src/H5Sff.f90 @@ -0,0 +1,460 @@ +! +! This file contains Fortran90 interfaces for H5S functions. +! + MODULE H5S + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + + SUBROUTINE h5screate_simple_f(rank, dims, space_id, hdferr, maxdims) + + IMPLICIT NONE + INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions + INTEGER(HSIZE_T), INTENT(IN) :: dims(rank) + ! Array with the dimension + ! sizes + INTEGER(HID_T), INTENT(OUT) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HSIZE_T), OPTIONAL, INTENT(IN) :: maxdims(rank) + ! Array with the maximum + ! dimension sizes + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:) :: f_maxdims + INTEGER, EXTERNAL :: h5screate_simple_c + + allocate (f_maxdims(rank), stat=hdferr) + if (hdferr .NE. 0) then + hdferr = -1 + return + endif + if (present(maxdims)) then + f_maxdims = maxdims + else + f_maxdims = dims + endif + hdferr = h5screate_simple_c(rank, dims, f_maxdims, space_id) + deallocate(f_maxdims) + + END SUBROUTINE h5screate_simple_f + + SUBROUTINE h5sclose_f(space_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sclose_c + + hdferr = h5sclose_c(space_id) + + END SUBROUTINE h5sclose_f + + SUBROUTINE h5screate_f(classtype, space_id, hdferr) + + IMPLICIT NONE + INTEGER, INTENT(IN) :: classtype ! The type of the dataspace + ! to be created. + ! Possible values are: + ! H5S_SCALAR_F (0) + ! H5S_SIMPLE_F(1) + INTEGER(HID_T), INTENT(OUT) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5screate_c + hdferr = h5screate_c(classtype, space_id) + + END SUBROUTINE h5screate_f + + + SUBROUTINE h5scopy_f(space_id, new_space_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HID_T), INTENT(OUT) :: new_space_id + ! Identifier of dataspace's copy + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5scopy_c + hdferr = h5scopy_c(space_id, new_space_id) + + END SUBROUTINE h5scopy_f + + SUBROUTINE h5sget_select_hyper_nblocks_f(space_id, num_blocks, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSSIZE_T), INTENT(OUT) :: num_blocks + !number of hyperslab blocks + !in the current dataspace + !selection + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_select_hyper_nblocks_c + hdferr = h5sget_select_hyper_nblocks_c (space_id, num_blocks) + + END SUBROUTINE h5sget_select_hyper_nblocks_f + + SUBROUTINE h5sget_select_hyper_blocklist_f(space_id, startblock, & + num_blocks, buf, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: startblock + !Hyperslab block to start with. + INTEGER(HSIZE_T), INTENT(IN) :: num_blocks + !number of hyperslab blocks + !to get in the current dataspace + !selection + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: buf + !List of hyperslab blocks selected + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5sget_select_hyper_blocklist_c + + hdferr = h5sget_select_hyper_blocklist_c(space_id, startblock, & + num_blocks, buf ) + + END SUBROUTINE h5sget_select_hyper_blocklist_f + + SUBROUTINE h5sget_select_bounds_f(space_id, start, end, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: start + !Starting coordinates of the bounding box. + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: end + !Ending coordinates of the bounding box, + !i.e., the coordinates of the diagonally + !opposite corner + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_select_bounds_c + hdferr = h5sget_select_bounds_c(space_id, start, end) + + END SUBROUTINE h5sget_select_bounds_f + + SUBROUTINE h5sget_select_elem_npoints_f(space_id, num_points, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSSIZE_T), INTENT(OUT) :: num_points + !number of element points + !in the current dataspace + !selection + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_select_elem_npoints_c + hdferr = h5sget_select_elem_npoints_c (space_id, num_points) + + END SUBROUTINE h5sget_select_elem_npoints_f + + SUBROUTINE h5sget_select_elem_pointlist_f(space_id, startpoint, & + num_points, buf, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T),DIMENSION(*), INTENT(IN) :: startpoint + !Element point to start with. + INTEGER(HSIZE_T), INTENT(IN) :: num_points + !Number of element points to get + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: buf + !List of element points selected + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_select_elem_pointlist_c + hdferr = h5sget_select_elem_pointlist_c(space_id, startpoint, & + num_points, buf ) + END SUBROUTINE h5sget_select_elem_pointlist_f + + SUBROUTINE h5sselect_elements_f(space_id, operator, rank, & + num_elements, coord, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(IN) :: operator ! Flag, valid values are: + ! H5S_SELECT_SET_F (0) + ! H5S_SELECT_OR_F (1) + INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions + INTEGER(SIZE_T), INTENT(IN) :: num_elements ! Number of elements to be + ! selected + INTEGER(HSSIZE_T), & + DIMENSION(rank,num_elements), INTENT(IN) :: coord + ! Array with the coordinates + ! of the selected elements + ! coord(rank, num_elements) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sselect_elements_c + INTEGER(HSSIZE_T), ALLOCATABLE, DIMENSION(:,:) :: c_coord + INTEGER :: error, i,j + allocate(c_coord(rank, num_elements), stat = error) + if (error.NE. 0) then + hdferr = -1 + return + endif + do i = 1, rank + c_coord(i,:) = coord(rank-i+1, :) - 1 + enddo + hdferr = h5sselect_elements_c(space_id, operator, num_elements, & + c_coord) + deallocate(c_coord) + + END SUBROUTINE h5sselect_elements_f + + + SUBROUTINE h5sselect_all_f(space_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sselect_all_c + hdferr = h5sselect_all_c(space_id) + + END SUBROUTINE h5sselect_all_f + + + SUBROUTINE h5sselect_none_f(space_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sselect_none_c + hdferr = h5sselect_none_c(space_id) + + END SUBROUTINE h5sselect_none_f + + + + SUBROUTINE h5sselect_valid_f(space_id, status, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + LOGICAL, INTENT(OUT) :: status ! TRUE if the selection is + ! contained within the extent, + ! FALSE otherwise. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: flag ! "TRUE/FALSE/ERROR" flag from C routine + INTEGER, EXTERNAL :: h5sselect_valid_c + hdferr = h5sselect_valid_c(space_id, flag) + status = .TRUE. + if (flag .EQ. 0) status = .FALSE. + + END SUBROUTINE h5sselect_valid_f + + + SUBROUTINE h5sget_simple_extent_npoints_f(space_id, npoints, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T), INTENT(OUT) :: npoints ! Number of elements in + ! dataspace + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_simple_extent_npoints_c + hdferr = h5sget_simple_extent_npoints_c( space_id, npoints) + + END SUBROUTINE h5sget_simple_extent_npoints_f + + + SUBROUTINE h5sget_select_npoints_f(space_id, npoints, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSSIZE_T), INTENT(OUT) :: npoints ! Number of elements in the + ! selection + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_select_npoints_c + hdferr = h5sget_select_npoints_c(space_id, npoints) + + END SUBROUTINE h5sget_select_npoints_f + + + SUBROUTINE h5sget_simple_extent_ndims_f(space_id, rank, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: rank ! Number of dimensions + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_simple_extent_ndims_c + hdferr = h5sget_simple_extent_ndims_c(space_id, rank) + + END SUBROUTINE h5sget_simple_extent_ndims_f + + + SUBROUTINE h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: dims + ! Array to store dimension sizes + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: maxdims + ! Array to store max dimension + ! sizes + INTEGER, INTENT(OUT) :: hdferr ! Error code: -1 on failure, + ! number of dimensions on + ! on success + INTEGER, EXTERNAL :: h5sget_simple_extent_dims_c + hdferr = h5sget_simple_extent_dims_c(space_id, dims, maxdims) + + END SUBROUTINE h5sget_simple_extent_dims_f + + + SUBROUTINE h5sget_simple_extent_type_f(space_id, classtype, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: classtype ! Class type , possible values + ! are: + ! H5S_NO_CLASS_F (-1) + ! H5S_SCALAR_F (0) + ! H5S_SIMPLE_F (1) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sget_simple_extent_type_c + hdferr = h5sget_simple_extent_type_c(space_id, classtype) + + END SUBROUTINE h5sget_simple_extent_type_f + + + SUBROUTINE h5sset_extent_simple_f(space_id, rank, current_size, & + maximum_size, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(IN) :: rank ! Dataspace rank + INTEGER(HSIZE_T), DIMENSION(rank), INTENT(IN) :: current_size + ! Array with the new sizes + ! of dimensions + INTEGER(HSIZE_T), DIMENSION(rank), INTENT(IN) :: maximum_size + ! Array with the new maximum + ! sizes of dimensions + ! sizes + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sset_extent_simple_c + hdferr = h5sset_extent_simple_c(space_id, rank, current_size, & + maximum_size) + + END SUBROUTINE h5sset_extent_simple_f + + + SUBROUTINE h5sis_simple_f(space_id, status, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + LOGICAL, INTENT(OUT) :: status ! Flag, idicates if dataspace + ! is simple or not ( TRUE or + ! FALSE) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: flag ! "TRUE/FALSE/ERROR from C" + INTEGER, EXTERNAL :: h5sis_simple_c + hdferr = h5sis_simple_c(space_id, flag) + status = .TRUE. + if (flag .EQ. 0) status = .FALSE. + + END SUBROUTINE h5sis_simple_f + + SUBROUTINE h5soffset_simple_f(space_id, offset, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSSIZE_T), DIMENSION(*), INTENT(IN) :: offset + ! The offset at which to position + ! the selection + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5soffset_simple_c + hdferr = h5soffset_simple_c(space_id, offset) + + END SUBROUTINE h5soffset_simple_f + + + SUBROUTINE h5sextent_copy_f(dest_space_id, source_space_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dest_space_id ! Identifier of destination + ! dataspace + INTEGER(HID_T), INTENT(IN) :: source_space_id ! Identifier of source + ! dataspace + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sextent_copy_c + hdferr = h5sextent_copy_c(dest_space_id, source_space_id) + + END SUBROUTINE h5sextent_copy_f + + + SUBROUTINE h5sset_extent_none_f(space_id, hdferr) + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5sset_extent_none_c + hdferr = h5sset_extent_none_c(space_id) + + END SUBROUTINE h5sset_extent_none_f + + + SUBROUTINE h5sselect_hyperslab_f(space_id, operator, start, count, & + hdferr, stride, block) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(IN) :: operator ! Flag, valid values are: + ! H5S_SELECT_SET_F (0) + ! H5S_SELECT_OR_F (1) + ! + INTEGER(HSSIZE_T), DIMENSION(*), INTENT(IN) :: start + ! Starting coordinates of the hyperslab + INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: count + ! Number of blocks to select + ! from dataspace + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HSIZE_T), DIMENSION(:), OPTIONAL, INTENT(IN) :: stride + ! Array of how many elements to move + ! in each direction + INTEGER(HSIZE_T), DIMENSION(:), OPTIONAL, INTENT(IN) :: block + ! Sizes of element block + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: def_block + INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: def_stride + INTEGER, EXTERNAL :: h5sselect_hyperslab_c + INTEGER :: rank + INTEGER :: error1, error2 + if (present(stride).and. present(block)) then + hdferr = h5sselect_hyperslab_c(space_id, operator, start, count, & + stride, block) + return + endif + ! Case of optional parameters. + ! + ! Find the rank of the dataspace to allocate memery for + ! default stride and block arrays. + ! + CALL h5sget_simple_extent_ndims_f(space_id, rank, hdferr) + if( hdferr .EQ. -1) return + ! + if (present(stride).and. .not.present(block)) then + allocate(def_block(rank), stat=error1) + if (error1.NE.0) then + hdferr = -1 + return + endif + def_block = 1 + hdferr = h5sselect_hyperslab_c(space_id, operator, start, count, & + stride, def_block) + deallocate(def_block) + return + endif + + if (.not.present(stride).and. present(block)) then + allocate(def_stride(rank), stat=error2) + if (error2.NE.0) then + hdferr = -1 + return + endif + def_stride = 1 + hdferr = h5sselect_hyperslab_c(space_id, operator, start, count, & + def_stride, block) + deallocate(def_stride) + return + endif + allocate(def_block(rank), stat=error1) + allocate(def_stride(rank), stat=error2) + if ((error1.NE.0) .OR. (error2.NE.0)) then + hdferr = -1 + return + endif + def_block = 1 + def_stride = 1 + hdferr = h5sselect_hyperslab_c(space_id, operator, start, count, & + def_stride, def_block) + deallocate(def_block) + deallocate(def_stride) + + END SUBROUTINE h5sselect_hyperslab_f + + END MODULE H5S diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c new file mode 100644 index 0000000..d097936 --- /dev/null +++ b/fortran/src/H5Tf.c @@ -0,0 +1,1543 @@ +#include "H5f90.h" + + +/*---------------------------------------------------------------------------- + * Name: h5topen_c + * Purpose: Call H5Topen to open a datatype + * Inputs: loc_id - file or group identifier + * name - name of the datatype within file or group + * namelen - name length + * Outputs: type_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_type_id; + hid_t c_loc_id; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Topen function. + */ + c_loc_id = *loc_id; + c_type_id = H5Topen(c_loc_id, c_name); + + if (c_type_id < 0) return ret_value; + *type_id = (hid_t_f)c_type_id; + HDfree(c_name); + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tcommit_c + * Purpose: Call H5Tcommit to commit a datatype + * Inputs: loc_id - file or group identifier + * name - name of the datatype within file or group + * namelen - name length + * type_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tcommit_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) +{ + int ret_value = -1; + char *c_name; + int c_namelen; + hid_t c_type_id; + hid_t c_loc_id; + herr_t status; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + /* + * Call H5Tcommit function. + */ + c_loc_id = *loc_id; + c_type_id = *type_id; + status = H5Tcommit(c_loc_id, c_name, c_type_id); + HDfree(c_name); + if (status < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tclose_c + * Purpose: Call H5Tclose to close the datatype + * Inputs: type_id - identifier of the datatype to be closed + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tclose_c ( hid_t_f *type_id ) +{ + int ret_value = 0; + hid_t c_type_id; + + c_type_id = *type_id; + if ( H5Tclose(c_type_id) < 0 ) ret_value = -1; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tcopy_c + * Purpose: Call H5Tcopy to copy a datatype + * Inputs: type_id - identifier of the datatype to be copied + * Outputs: new_type_id - identifier of the new datatype + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tcopy_c ( hid_t_f *type_id , hid_t_f *new_type_id) +{ + int ret_value = 0; + hid_t c_type_id; + hid_t c_new_type_id; + + c_type_id = *type_id; + c_new_type_id = H5Tcopy(c_type_id); + if ( c_new_type_id < 0 ) ret_value = -1; + *new_type_id = (hid_t_f)c_new_type_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tequal_c + * Purpose: Call H5Tequal to copy a datatype + * Inputs: type1_id - datatype identifier + * type2_id - datatype identifier + * Outputs: c_flag - flag; indicates if two datatypes are equal or not. + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, February 22, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tequal_c ( hid_t_f *type1_id , hid_t_f *type2_id, int_f *c_flag) +{ + int ret_value = -1; + hid_t c_type1_id, c_type2_id; + htri_t status; + + c_type1_id = *type1_id; + c_type2_id = *type2_id; + status = H5Tequal(c_type1_id, c_type2_id); + if ( status < 0 ) return ret_value; + *c_flag = (int_f)status; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tget_class_c + * Purpose: Call H5Tget_class to determine the datatype class + * Inputs: type_id - identifier of the dataspace + * Outputs: classtype - class type; possible values are: + * H5T_NO_CLASS_F (-1) + * H5T_INTEGER_F (0) + * H5T_FLOAT_F (1) + * H5T_TIME_F (2) + * H5T_STRING_F (3) + * H5T_BITFIELD_F (4) + * H5T_OPAQUE_F (5) + * H5T_COMPOUNDF (6) + * H5T_REFERENCE_F (7) + * H5T_ENUMF (8) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_class_c ( hid_t_f *type_id , int_f *classtype) +{ + int ret_value = 0; + hid_t c_type_id; + H5T_class_t c_classtype; + + c_type_id = *type_id; + c_classtype = H5Tget_class(c_type_id); + if (c_classtype == H5T_NO_CLASS ) { + *classtype = H5T_NO_CLASS_F; + ret_value = -1; + return ret_value; + } + if (c_classtype == H5T_INTEGER) *classtype = H5T_INTEGER_F; + if (c_classtype == H5T_FLOAT) *classtype = H5T_FLOAT_F; + if (c_classtype == H5T_TIME) *classtype = H5T_TIME_F; + if (c_classtype == H5T_STRING) *classtype = H5T_STRING_F; + if (c_classtype == H5T_BITFIELD) *classtype = H5T_BITFIELD_F; + if (c_classtype == H5T_OPAQUE) *classtype = H5T_OPAQUE_F; + if (c_classtype == H5T_COMPOUND) *classtype = H5T_COMPOUND_F; + if (c_classtype == H5T_REFERENCE) *classtype = H5T_REFERENCE_F; + if (c_classtype == H5T_ENUM) *classtype = H5T_ENUM_F; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_order_c + * Purpose: Call H5Tget_order to determine byte order + * Inputs: type_id - identifier of the dataspace + * Outputs: order; possible values are: + * H5T_ORDER_LE_F (0) + * H5T_ORDER_BE_F (1) + * H5T_ORDER_VAX_F (2) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_order_c ( hid_t_f *type_id , int_f *order) +{ + int ret_value = -1; + hid_t c_type_id; + H5T_order_t c_order; + + c_type_id = *type_id; + c_order = H5Tget_order(c_type_id); + if ( c_order < 0 ) return ret_value; + if ( c_order == H5T_ORDER_LE) *order = H5T_ORDER_LE_F; + if ( c_order == H5T_ORDER_BE) *order = H5T_ORDER_BE_F; + if ( c_order == H5T_ORDER_VAX) *order = H5T_ORDER_VAX_F; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tset_order_c + * Purpose: Call H5Tset_order to set byte order + * Inputs: type_id - identifier of the dataspace + * order; possible values are: + * H5T_ORDER_LE_F (0) + * H5T_ORDER_BE_F (1) + * H5T_ORDER_VAX_F (2) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_order_c ( hid_t_f *type_id , int_f *order) +{ + int ret_value = 0; + hid_t c_type_id; + H5T_order_t c_order; + herr_t status; + + if ( *order == H5T_ORDER_LE_F) c_order = H5T_ORDER_LE; + if ( *order == H5T_ORDER_BE_F) c_order = H5T_ORDER_BE; + if ( *order == H5T_ORDER_VAX_F) c_order = H5T_ORDER_VAX; + c_type_id = *type_id; + status = H5Tset_order(c_type_id, c_order); + if ( status < 0 ) ret_value = -1; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_size_c + * Purpose: Call H5Tget_size to get size of the datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: size (in bytes) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_size_c ( hid_t_f *type_id , size_t_f *size) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_size; + + c_type_id = *type_id; + c_size = H5Tget_size(c_type_id); + if ( c_size == 0 ) return ret_value; + *size = (size_t_f)c_size ; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_size_c + * Purpose: Call H5Tget_size to get size of the datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: size (in bytes) + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Saturday, August 14, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_size_c ( hid_t_f *type_id , size_t_f *size) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_size; + herr_t status; + + c_size = (size_t)*size; + c_type_id = *type_id; + status = H5Tset_size(c_type_id, c_size); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_precision_c + * Purpose: Call H5Tget_precision to get precision of the datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: precision - number of significant bits + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Tuesday, January 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_precision_c ( hid_t_f *type_id , size_t_f *precision) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_precision; + + c_type_id = *type_id; + c_precision = H5Tget_precision(c_type_id); + if ( c_precision == 0 ) return ret_value; + *precision = (size_t_f)c_precision ; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_precision_c + * Purpose: Call H5Tset_precision to set precision of the datatype + * Inputs: type_id - identifier of the dataspace + * precision - number of significant bits + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Tuesday, January 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_precision_c ( hid_t_f *type_id , size_t_f *precision) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_precision; + herr_t status; + + c_type_id = *type_id; + c_precision = (size_t)*precision; + status = H5Tset_precision(c_type_id, c_precision); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_offset_c + * Purpose: Call H5Tget_offset to get bit offset of the first + * significant bit of the datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: offset - bit offset of the first significant bit + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Tuesday, January 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_offset_c ( hid_t_f *type_id , size_t_f *offset) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_offset; + + c_type_id = *type_id; + c_offset = H5Tget_offset(c_type_id); + if ( c_offset == 0 ) return ret_value; + + *offset = (size_t_f)c_offset ; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_offset_c + * Purpose: Call H5Tset_offset to set bit offset of the first + * significant bit of the datatype + * Inputs: type_id - identifier of the dataspace + * offset - bit offset of the first significant bit + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Tuesday, January 25, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_offset_c ( hid_t_f *type_id , size_t_f *offset) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_offset; + herr_t status; + + c_offset = (size_t)*offset; + c_type_id = *type_id; + status = H5Tset_offset(c_type_id, c_offset); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_pad_c + * Purpose: Call H5Tget_pad to get the padding type of the least and + * most-significant bit padding + * + * Inputs: type_id - identifier of the dataspace + * Outputs: lsbpad - padding type of the least significant bit + * msbpad - padding type of the least significant bit + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_pad_c ( hid_t_f *type_id , int_f * lsbpad, int_f * msbpad) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_pad_t c_lsb, c_msb; + + c_type_id = *type_id; + status = H5Tget_pad(c_type_id, &c_lsb, &c_msb); + if ( status < 0 ) return ret_value; + + *lsbpad = (int_f) c_lsb; + *msbpad = (int_f) c_msb; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_pad_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_pad to set the padding type of the least and + * most-significant bit padding + * + * Inputs: type_id - identifier of the dataspace + * lsbpad - padding type of the least significant bit + * msbpad - padding type of the least significant bit + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_pad_c ( hid_t_f *type_id, int_f * lsbpad, int_f* msbpad ) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_pad_t c_lsb, c_msb; + + c_type_id = *type_id; + c_lsb = (H5T_pad_t)*lsbpad; + c_msb = (H5T_pad_t)*msbpad; + status = H5Tset_pad(c_type_id, c_lsb, c_msb); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_sign_c + * Purpose: Call H5Tget_sign to get sign type for an integer type + * Inputs: type_id - identifier of the dataspace + * Outputs: sign - sign type for an integer type + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_sign_c ( hid_t_f *type_id , int_f *sign) +{ + int ret_value = -1; + hid_t c_type_id; + H5T_sign_t c_sign; + + c_type_id = *type_id; + c_sign = H5Tget_sign(c_type_id); + if ( c_sign == -1 ) return ret_value; + *sign = (int_f)c_sign ; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_sign_c + * Purpose: Call H5Tset_sign to set sign type for an integer type + * Inputs: type_id - identifier of the dataspace + * sign - sign type for an integer typ + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_sign_c ( hid_t_f *type_id , int_f* sign) +{ + int ret_value = -1; + hid_t c_type_id; + H5T_sign_t c_sign; + herr_t status; + + c_type_id = *type_id; + c_sign = (H5T_sign_t)*sign; + status = H5Tset_sign(c_type_id, c_sign); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_fields_c + * Purpose: Call H5Tget_fields to get floating point datatype + * bit field information + * Inputs: type_id - identifier of the dataspace + * Outputs: epos - exponent bit-position + * esize - size of exponent in bits + * mpos - mantissa bit-position + * msize - size of mantissa in bits + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, January 27, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_fields_c ( hid_t_f *type_id , size_t_f *spos, size_t_f *epos, size_t_f* esize, size_t_f* mpos, size_t_f* msize) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + size_t c_spos, c_epos, c_esize, c_mpos, c_msize; + + c_type_id = *type_id; + status = H5Tget_fields(c_type_id, &c_spos, &c_epos, &c_esize, &c_mpos, &c_msize); + if ( status < 0 ) return ret_value; + *spos = (size_t_f) c_spos; + *epos = (size_t_f) c_epos; + *esize = (size_t_f) c_esize; + *mpos = (size_t_f) c_mpos; + *msize = (size_t_f) c_msize; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_fields_c + * Purpose: Call H5Tset_fields to set floating point datatype + * bit field information + * Inputs: type_id - identifier of the dataspace + * epos - exponent bit-position + * esize - size of exponent in bits + * mpos - mantissa bit-position + * msize - size of mantissa in bits + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_fields_c ( hid_t_f *type_id, size_t_f *spos, size_t_f *epos, size_t_f* esize, size_t_f* mpos, size_t_f* msize) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + size_t c_spos, c_epos, c_esize, c_mpos, c_msize; + + c_spos = (size_t)*spos; + c_epos = (size_t)*epos; + c_esize = (size_t)*esize; + c_mpos = (size_t)*mpos; + c_msize = (size_t)*msize; + c_type_id = *type_id; + status = H5Tset_fields(c_type_id, c_spos, c_epos, c_esize, c_mpos, c_msize); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_ebias_c + * Purpose: Call H5Tget_ebias to get exponent bias of a + * floating-point type of the datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: ebias - exponent bias of a floating-point type of the datatype + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, January 27, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_ebias_c ( hid_t_f *type_id , size_t_f *ebias) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_ebias; + + c_type_id = *type_id; + c_ebias = H5Tget_ebias(c_type_id); + if ( c_ebias == 0 ) return ret_value; + + *ebias = (size_t_f)c_ebias; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_ebias_c + * Purpose: Call H5Tset_ebias to set exponent bias of a + * floating-point type of the datatype + * Inputs: type_id - identifier of the dataspace + * ebias - exponent bias of a floating-point type of the datatyp + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, January 27, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_ebias_c ( hid_t_f *type_id , size_t_f *ebias) +{ + int ret_value = -1; + hid_t c_type_id; + size_t c_ebias; + herr_t status; + + c_type_id = *type_id; + c_ebias = (size_t)*ebias; + status = H5Tset_ebias(c_type_id, c_ebias); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_norm_c + * Purpose: Call H5Tget_norm to get mantissa normalization + * of a floating-point datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: norm - mantissa normalization of a floating-point type + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, January 27, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_norm_c ( hid_t_f *type_id , int_f *norm) +{ + int ret_value = -1; + hid_t c_type_id; + H5T_norm_t c_norm; + + c_type_id = *type_id; + c_norm = H5Tget_norm(c_type_id); + if ( c_norm == 0 ) return ret_value; + + *norm = (size_t_f)c_norm; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_norm_c + * Purpose: Call H5Tset_norm to set mantissa normalization of + * floating-point type of the datatype + * Inputs: type_id - identifier of the dataspace + * norm - mantissa normalization of a floating-point type + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Friday, January 27, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_norm_c ( hid_t_f *type_id , int_f *norm) +{ + int ret_value = -1; + hid_t c_type_id; + H5T_norm_t c_norm; + herr_t status; + + c_type_id = *type_id; + c_norm = (H5T_norm_t)*norm; + status = H5Tset_norm(c_type_id, c_norm); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_inpad_c + * Purpose: Call H5Tget_inpad to get the padding type for + * unused bits in floating-point datatypes + * + * Inputs: type_id - identifier of the dataspace + * Outputs: padtype - padding type for + * unused bits in floating-point datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_inpad_c ( hid_t_f *type_id , int_f * padtype) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_pad_t c_padtype; + + c_type_id = *type_id; + c_padtype = H5Tget_inpad(c_type_id); + if ( c_padtype == H5T_PAD_ERROR ) return ret_value; + + *padtype = (int_f) c_padtype; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_inpad_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_inpad to set the padding type + * unused bits in floating-point datatype + * + * Inputs: type_id - identifier of the dataspace + * padtype - padding type for unused bits + * in floating-point datatypes + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_inpad_c ( hid_t_f *type_id, int_f * padtype) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_pad_t c_padtype; + + c_type_id = *type_id; + c_padtype = (H5T_pad_t)*padtype; + status = H5Tset_inpad(c_type_id, c_padtype); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_cset_c + * Purpose: Call H5Tget_cset to get character set + * type of a string datatype + * + * Inputs: type_id - identifier of the dataspace + * Outputs: cset - character set type of a string datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_cset_c ( hid_t_f *type_id , int_f * cset) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_cset_t c_cset; + + c_type_id = *type_id; + c_cset = H5Tget_cset(c_type_id); + if ( c_cset == H5T_CSET_ERROR ) return ret_value; + + *cset = (int_f) c_cset; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_cset_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_cset to set character set + * type of a string datatype + * + * Inputs: type_id - identifier of the dataspace + * cset - character set type of a string datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_cset_c ( hid_t_f *type_id, int_f * cset) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_cset_t c_cset; + + c_type_id = *type_id; + c_cset = (H5T_cset_t)*cset; + status = H5Tset_cset(c_type_id, c_cset); + + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_strpad_c + * Purpose: Call H5Tget_strpad to get string padding method + * for a string datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: strpad - string padding method for a string datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_strpad_c ( hid_t_f *type_id , int_f * strpad) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_str_t c_strpad; + + c_type_id = *type_id; + c_strpad = H5Tget_strpad(c_type_id); + if ( c_strpad == H5T_STR_ERROR ) return ret_value; + + *strpad = (int_f) c_strpad; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_strpad_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_strpad to set string padding method + * for a string datatype + * + * Inputs: type_id - identifier of the dataspace + * strpad - string padding method for a string datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tset_strpad_c ( hid_t_f *type_id, int_f * strpad) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + H5T_str_t c_strpad; + + c_type_id = *type_id; + c_strpad = (H5T_str_t)*strpad; + status = H5Tset_strpad(c_type_id, c_strpad); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_nmembers_c + * Purpose: Call H5Tget_nmembers to get number of fields + * in a compound datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: num_members - number of fields in a compound datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_nmembers_c ( hid_t_f *type_id , int_f * num_members) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + + c_type_id = *type_id; + *num_members = (int_f)H5Tget_nmembers(c_type_id); + if (*num_members < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_member_name_c + * Purpose: Call H5Tget_member_name to get name + * of a compound datatype + * Inputs: type_id - identifier of the dataspace + * Outputs: member_name - name of a field of a compound datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: Elena Pourmal + * Added namelen parameter to return length of the name to Fortran user + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member_name, int_f *namelen) +{ + int ret_value = -1; + hid_t c_type_id; + int c_index; + char *c_name; + + c_type_id = *type_id; + c_index = *index; + c_name = H5Tget_member_name(c_type_id, c_index); + if (c_name == NULL ) return ret_value; + + HDpackFstring(c_name, _fcdtocp(member_name), strlen(c_name)); + *namelen = (int_f)strlen(c_name); + HDfree(c_name); + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_member_offset_c + * Purpose: Call H5Tget_member_offset to get byte offset of the + * beginning of a field within a compound datatype with + * respect to the beginning of the compound data type datum + * Inputs: type_id - identifier of the dataspace + * member_no - Number of the field whose offset is requested + * Outputs: offset - byte offset of the the beginning of the field of + * a compound datatype + * Returns: always 0 + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f * offset) +{ + int ret_value = -1; + size_t c_offset; + hid_t c_type_id; + int c_member_no; + + c_type_id = *type_id; + c_member_no = *member_no; + c_offset = H5Tget_member_offset(c_type_id, c_member_no); + *offset = (size_t_f)c_offset; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_member_dims_c + * Purpose: Call H5Tget_member_dims to get number + * of dimensions of the field + * Inputs: type_id - identifier of the dataspace + * field_idx - Field index (0-based) of the field + * dims to retrieve + * Outputs: dims - number of dimensions of the field + * field_dims - buffer to store the dimensions of the field + * perm - buffer to store the permutation vector of the field + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t_f * field_dims, int_f * perm ) +{ + int ret_value = -1; + hid_t c_type_id; + int c_dims, i; + int* c_perm; + size_t * c_field_dims; + int c_field_idx; + + c_field_dims = (size_t*)malloc(sizeof(size_t)*4); + if(!c_field_dims) return ret_value; + + c_perm = (int*)malloc(sizeof(int)*4); + if(!c_perm) return ret_value; + + c_type_id = *type_id; + c_field_idx = *field_idx; + c_dims = H5Tget_member_dims(c_type_id, c_field_idx, c_field_dims, c_perm); + if (c_dims < 0) return ret_value; + + *dims = (int_f)c_dims; + for(i =0; i < c_dims; i++) + { + field_dims[c_dims-i-1] = (size_t_f)c_field_dims[i]; + perm[c_dims-i-1] = (int_f)c_perm[i]; + } + + ret_value = 0; + HDfree(c_field_dims); + HDfree(c_perm); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_member_type_c + * Purpose: Call H5Tget_member_type to get the identifier of a copy of + * the datatype of the field + * Inputs: type_id - identifier of the datatype + * field_idx - Field index (0-based) of the field type to retrieve + * Outputs: datatype - identifier of a copy of the datatype of the field + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype) +{ + int ret_value = -1; + hid_t c_type_id; + int c_field_idx; + + c_type_id = *type_id; + c_field_idx = *field_idx; + *datatype = (hid_t_f)H5Tget_member_type(c_type_id, c_field_idx); + if(*datatype < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tcreate_c + * Purpose: Call H5Tcreate to create a datatype + * Inputs: class - class type + * size - size of the class memeber + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Thursday, February 17, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tcreate_c(int_f *class, size_t_f *size, hid_t_f *type_id) +{ + int ret_value = -1; + H5T_class_t c_class; + size_t c_size; + + c_size =(size_t) *size; + c_class = (H5T_class_t) *class; + + *type_id = (hid_t_f)H5Tcreate(c_class, c_size); + if(*type_id < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tinsert_c + * Purpose: Call H5Tinsert to adds another member to the compound datatype + * Inputs: type_id - identifier of the datatype + * name - Name of the field to insert + * namelen - length of the name + * offset - Offset in memory structure of the field to insert + * field_id - datatype identifier of the new member + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_t_f * field_id) +{ + int ret_value = -1; + hid_t c_type_id; + hid_t c_field_id; + char* c_name; + int c_namelen; + size_t c_offset; + herr_t error; + + c_offset =(size_t) *offset; + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_type_id = *type_id; + c_field_id = *field_id; + error = H5Tinsert(c_type_id, c_name, c_offset, c_field_id); + HDfree(c_name); + if(error < 0) return ret_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tpack_c + * Purpose: Call H5Tpack tor ecursively remove padding from + * within a compound datatype to make it more efficient + * (space-wise) to store that data + * Inputs: type_id - identifier of the datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tpack_c(hid_t_f * type_id) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + + c_type_id = *type_id; + status = H5Tpack(c_type_id); + if (status < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tinsert_array_c + * Purpose: Call H5Tinsert_array to add a new member to the + * compound datatype parent_id. + * Inputs: parent_id - identifier of the parent compound datatype + * name - name of the new member + * namelen - length of the name + * offset - Offset to start of new member within compound datatype + * ndims - Dimensionality of new member. Valid values + * are 0 (zero) through 4 (four). + * dims - Size of new member array + * member_id - identifier of the datatype of the new member + * perm - Pointer to buffer to store the permutation + * vector of the field + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id, int_f* perm ) +{ + int ret_value = -1; + hid_t c_parent_id; + hid_t c_member_id; + int c_ndims; + herr_t status; + size_t c_offset; + size_t * c_dims; + char* c_name; + int c_namelen; + int * c_perm, i; + + c_offset = *offset; + c_dims = (size_t*)malloc(sizeof(size_t)*(*ndims)); + if(!c_dims) return ret_value; + + c_perm = (int*)malloc(sizeof(int)*(*ndims)); + if(!c_perm) return ret_value; + + /* + * Transpose dimension arrays because of C-FORTRAN storage order + */ + for (i = 0; i < *ndims ; i++) { + c_dims[i] = (size_t)dims[*ndims - i - 1]; + c_perm[i] = (int)perm[*ndims - i - 1]; + } + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_parent_id = *parent_id; + c_member_id = *member_id; + c_ndims = *ndims; + status = H5Tinsert_array(c_parent_id, c_name, c_offset,c_ndims, c_dims, c_perm, c_member_id); + + if(status < 0) return ret_value; + ret_value = 0; + + return ret_value; + +} + + +/*---------------------------------------------------------------------------- + * Name: h5tinsert_array_c2 + * Purpose: Call H5Tinsert_array to add a new member to the + * compound datatype parent_id. + * the difference between this function and h5tinsert_array_c + * is that this one doesn't take perm array as input + * Inputs: parent_id - identifier of the parent compound datatype + * name - name of the new member + * namelen - length of the name + * offset - Offset to start of new member within compound datatype + * ndims - Dimensionality of new member. Valid values + * are 0 (zero) through 4 (four). + * dims - Size of new member array + * member_id - identifier of the datatype of the new member + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id ) +{ + int ret_value = -1; + hid_t c_parent_id; + hid_t c_member_id; + int c_ndims; + herr_t status; + size_t c_offset; + size_t * c_dims; + char* c_name; + int c_namelen; + int i; + + c_offset = *offset; + c_dims = (size_t*)malloc(sizeof(size_t)*(*ndims)); + if(!c_dims) return ret_value; + + /* + * Transpose dimension arrays because of C-FORTRAN storage order + */ + for (i = 0; i < *ndims ; i++) { + c_dims[i] = (size_t)dims[*ndims - i - 1]; + } + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_parent_id = *parent_id; + c_member_id = *member_id; + c_ndims = *ndims; + status = H5Tinsert_array(c_parent_id, c_name, c_offset, c_ndims, c_dims, NULL, c_member_id); + + if(status < 0) return ret_value; + ret_value = 0; + + return ret_value; + +} + +/*---------------------------------------------------------------------------- + * Name: h5tenum_create_c + * Purpose: Call H5Tenum_create to create a new enumeration datatype + * Inputs: parent_id - Datatype identifier for the base datatype + * Outputs: new_type_id - datatype identifier for the new + * enumeration datatype + * Returns: 0 on success, -1 on failure + * Programmer: Xiangyang Su + * Tuesday, February 15, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id) +{ + int ret_value = 0; + hid_t c_parent_id; + hid_t c_new_type_id; + + c_parent_id = *parent_id; + c_new_type_id = H5Tenum_create(c_parent_id); + if ( c_new_type_id < 0 ) ret_value = -1; + + *new_type_id = (hid_t_f)c_new_type_id; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tenum_insert_c + * Purpose: Call H5Tenum_insert to insert a new enumeration datatype member. + * Inputs: type_id - identifier of the datatype + * name - Name of the new member + * namelen - length of the name + * value - value of the new member + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) +{ + int ret_value = -1; + hid_t c_type_id; + char* c_name; + int c_namelen; + int c_value; + herr_t error; + + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_type_id = *type_id; + c_value = *value; + error = H5Tenum_insert(c_type_id, c_name, (void*)c_value); + HDfree(c_name); + if(error < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tenum_nameof_c + * Purpose: Call H5Tenum_nameof to find the symbol name that corresponds to + * the specified value of the enumeration datatype type + * Inputs: type_id - identifier of the datatype + * namelen - length of the name + * value - value of the enumeration datatype + * Output: name - Name of the enumeration datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen) +{ + int ret_value = -1; + hid_t c_type_id; + char* c_name; + size_t c_namelen; + herr_t error; + int c_value; + c_value = *value; + c_namelen = (size_t)*namelen; + c_name = (char *)malloc(sizeof(char)*c_namelen); + c_type_id = *type_id; + error = H5Tenum_nameof(c_type_id, &c_value, c_name, c_namelen); + HDpackFstring(c_name, _fcdtocp(name), strlen(c_name)); + HDfree(c_name); + + if(error < 0) return ret_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tenum_valueof_c + * Purpose: Call H5Tenum_valueof to find the value of that corresponds to + * the specified name of the enumeration datatype type + * Inputs: type_id - identifier of the datatype + * name - Name of the enumeration datatype + * namelen - length of name + * Output: value - value of the enumeration datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value) +{ + int ret_value = -1; + hid_t c_type_id; + char* c_name; + int c_namelen; + int c_value; + herr_t error; + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + c_type_id = *type_id; + error = H5Tenum_valueof(c_type_id, c_name, &c_value); + HDfree(c_name); + if(error < 0) return ret_value; + *value = (int_f)c_value; + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5tget_member_value_c + * Purpose: Call H5Tget_member_value to get the value of an + * enumeration datatype member + * Inputs: type_id - identifier of the datatype + * member_no - Number of the enumeration datatype member. + * Output: value - value of the enumeration datatype + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Thursday, February 3, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value) +{ + int ret_value = -1; + hid_t c_type_id; + int c_member_no; + int c_value; + herr_t error; + + c_type_id = *type_id; + c_member_no = *member_no; + error = H5Tget_member_value(c_type_id, c_member_no, &c_value); + if(error < 0) return ret_value; + + *value = (int_f)c_value; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tset_tag_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_tag to set an opaque datatype tag + * Inputs: type_id - identifier of the dataspace + * tag - Unique ASCII string with which the opaque + * datatype is to be tagged + * namelen - length of tag + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tset_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen) +{ + int ret_value = -1; + hid_t c_type_id; + herr_t status; + char* c_tag; + int c_namelen; + + c_namelen = *namelen; + c_tag = (char *)HD5f2cstring(tag, c_namelen); + + c_type_id = *type_id; + status = H5Tset_tag(c_type_id, c_tag); + HDfree(c_tag); + if ( status < 0 ) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_tag_c + * Inputs: type_id - identifier of the dataspace + * Purpose: Call H5Tset_tag to set an opaque datatype tag + * Inputs: type_id - identifier of the dataspace + * Outputs: tag - Unique ASCII string with which the opaque + * datatype is to be tagged + * taglen - length of tag + * Returns: 0 on success, -1 on failure + * Programmer: XIANGYANG SU + * Wednesday, January 26, 2000 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tget_tag_c(hid_t_f* type_id, _fcd tag, int_f* taglen) +{ + int ret_value = -1; + hid_t c_type_id; + char *c_tag; + + c_type_id = *type_id; + c_tag = H5Tget_tag(c_type_id); + if (c_tag == NULL ) return ret_value; + + HDpackFstring(c_tag, _fcdtocp(tag), strlen(c_tag)); + *taglen = strlen(c_tag); + HDfree(c_tag); + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90 new file mode 100644 index 0000000..5560dc8 --- /dev/null +++ b/fortran/src/H5Tff.f90 @@ -0,0 +1,599 @@ +! +! This file contains FORTRAN90 interfaces for H5T functions +! + MODULE H5T + + USE H5FORTRAN_TYPES + USE H5FORTRAN_FLAGS + + CONTAINS + + SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name + ! Datatype name within file or group + INTEGER(HID_T), INTENT(OUT) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5topen_c + namelen = LEN(name) + hdferr = h5topen_c(loc_id, name, namelen, type_id) + END SUBROUTINE h5topen_f + + SUBROUTINE h5tcommit_f(loc_id, name, type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name + ! Datatype name within file or group + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen ! Name length + INTEGER, EXTERNAL :: h5tcommit_c + namelen = LEN(name) + hdferr = h5tcommit_c(loc_id, name, namelen, type_id) + END SUBROUTINE h5tcommit_f + + + SUBROUTINE h5tcopy_f(type_id, new_type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(HID_T), INTENT(OUT) :: new_type_id + ! Identifier of datatype's copy + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tcopy_c + hdferr = h5tcopy_c(type_id, new_type_id) + END SUBROUTINE h5tcopy_f + + SUBROUTINE h5tequal_f(type1_id, type2_id, flag, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type1_id ! Datatype identifier + INTEGER(HID_T), INTENT(IN) :: type2_id ! Datatype identifier + LOGICAL, INTENT(OUT) :: flag ! TRUE/FALSE flag to indicate if two + ! datatypes are equal + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: c_flag + INTEGER, EXTERNAL :: h5tequal_c + flag = .FALSE. + hdferr = h5tequal_c(type1_id, type2_id, c_flag) + if(c_flag .gt. 0) flag = .TRUE. + END SUBROUTINE h5tequal_f + + + SUBROUTINE h5tclose_f(type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tclose_c + hdferr = h5tclose_c(type_id) + END SUBROUTINE h5tclose_f + + + SUBROUTINE h5tget_class_f(type_id, class, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: class + ! Datatype class, possible values are: + ! H5T_NO_CLASS_F (-1) + ! H5T_INTEGER_F (0) + ! H5T_FLOAT_F (1) + ! H5T_TIME_F (2) + ! H5T_STRING_F (3) + ! H5T_BITFIELD_F (4) + ! H5T_OPAQUE_F (5) + ! H5T_COMPOUND_F (6) + ! H5T_REFERENCE_F (7) + ! H5T_ENUM_F (8) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_class_c + hdferr = h5tget_class_c(type_id, class) + END SUBROUTINE h5tget_class_f + + + SUBROUTINE h5tget_size_f(type_id, size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(OUT) :: size ! Datatype size + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_size_c + hdferr = h5tget_size_c(type_id, size) + END SUBROUTINE h5tget_size_f + + + SUBROUTINE h5tset_size_f(type_id, size, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(IN) :: size ! Datatype size + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_size_c + hdferr = h5tset_size_c(type_id, size) + END SUBROUTINE h5tset_size_f + + + SUBROUTINE h5tget_order_f(type_id, order, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: order + ! Datatype byte order, bossible values are: + ! H5T_ORDER_LE (0) + ! H5T_ORDER_BE (1) + ! H5T_ORDER_VAX (2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_order_c + hdferr = h5tget_order_c(type_id, order) + END SUBROUTINE h5tget_order_f + + + SUBROUTINE h5tset_order_f(type_id, order, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: order ! Datatype byte order, bossible values + ! are: + ! H5T_ORDER_LE (0) + ! H5T_ORDER_BE (1) + ! H5T_ORDER_VAX (2) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_order_c + hdferr = h5tset_order_c(type_id, order) + END SUBROUTINE h5tset_order_f + + + SUBROUTINE h5tget_precision_f(type_id, precision, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(OUT) :: precision ! Datatype precision + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_precision_c + hdferr = h5tget_precision_c(type_id, precision) + END SUBROUTINE h5tget_precision_f + + SUBROUTINE h5tset_precision_f(type_id, precision, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(IN) :: precision ! Datatype precision + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_precision_c + hdferr = h5tset_precision_c(type_id, precision) + END SUBROUTINE h5tset_precision_f + + SUBROUTINE h5tget_offset_f(type_id, offset, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(OUT) :: offset ! Datatype bit offset of the + ! first significant bit + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_offset_c + hdferr = h5tget_offset_c(type_id, offset) + END SUBROUTINE h5tget_offset_f + + SUBROUTINE h5tset_offset_f(type_id, offset, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(IN) :: offset ! Datatype bit offset of the + ! first significant bit + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_offset_c + hdferr = h5tset_offset_c(type_id, offset) + END SUBROUTINE h5tset_offset_f + + SUBROUTINE h5tget_pad_f(type_id, lsbpad, msbpad, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: lsbpad ! padding type of the + ! least significant bit + INTEGER, INTENT(OUT) :: msbpad ! padding type of the + ! most significant bit + ! Possible values of padding type are: + ! H5T__PAD_ZERO_F = 0 + ! H5T__PAD_ONE_F = 1 + ! H5T__PAD_BACKGROUND_F = 2 + ! H5T_PAD_ERROR_F = -1 + ! H5T_PAD_NPAD_F = 3 + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_pad_c + hdferr = h5tget_pad_c(type_id, lsbpad, msbpad) + END SUBROUTINE h5tget_pad_f + + SUBROUTINE h5tset_pad_f(type_id, lsbpad, msbpad, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: lsbpad ! padding type of the + ! least significant bit + INTEGER, INTENT(IN) :: msbpad ! padding type of the + ! most significant bit + ! Possible values of padding type are: + ! H5T_PAD_ZERO_F = 0 + ! H5T_PAD_ONE_F = 1 + ! H5T_PAD_BACKGROUND_F = 2 + ! H5T_PAD_ERROR_F = -1 + ! H5T_PAD_NPAD_F = 3 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_pad_c + hdferr = h5tset_pad_c(type_id, lsbpad, msbpad) + END SUBROUTINE h5tset_pad_f + + SUBROUTINE h5tget_sign_f(type_id, sign, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: sign ! sign type for an integer type + !possible values are: + !Unsigned integer type H5T_SGN_NONE_F = 0 + !Two's complement signed integer type + !H5T_SGN_2_F = 1 + !or error value: H5T_SGN_ERROR_F=-1 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_sign_c + hdferr = h5tget_sign_c(type_id, sign) + END SUBROUTINE h5tget_sign_f + + SUBROUTINE h5tset_sign_f(type_id, sign, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: sign !sign type for an integer type + !possible values are: + !Unsigned integer type H5T_SGN_NONE_F = 0 + !Two's complement signed integer type + !H5T_SGN_2_F = 1 + !or error value: H5T_SGN_ERROR_F=-1 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_sign_c + hdferr = h5tset_sign_c(type_id, sign) + END SUBROUTINE h5tset_sign_f + + SUBROUTINE h5tget_fields_f(type_id, epos, esize, mpos, msize, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: epos ! exponent bit-position + INTEGER, INTENT(OUT) :: esize ! size of exponent in bits + INTEGER, INTENT(OUT) :: mpos ! mantissa bit-position + INTEGER, INTENT(OUT) :: msize ! size of mantissa in bits + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5tget_fields_c + hdferr = h5tget_fields_c(type_id, epos, esize, mpos, msize, hdferr) + END SUBROUTINE h5tget_fields_f + + SUBROUTINE h5tset_fields_f(type_id, epos, esize, mpos, msize, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: epos ! exponent bit-position + INTEGER, INTENT(IN) :: esize ! size of exponent in bits + INTEGER, INTENT(IN) :: mpos ! mantissa bit-position + INTEGER, INTENT(IN) :: msize ! size of mantissa in bits + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, EXTERNAL :: h5tset_fields_c + hdferr = h5tset_fields_c(type_id, epos, esize, mpos, msize) + END SUBROUTINE h5tset_fields_f + + SUBROUTINE h5tget_ebias_f(type_id, ebias, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(OUT) :: ebias ! Datatype exponent bias of a floating-point type + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_ebias_c + hdferr = h5tget_ebias_c(type_id, ebias) + END SUBROUTINE h5tget_ebias_f + + + SUBROUTINE h5tset_ebias_f(type_id, ebias, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER(SIZE_T), INTENT(IN) :: ebias !Datatype exponent bias of a floating-point type + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_ebias_c + hdferr = h5tset_ebias_c(type_id, ebias) + END SUBROUTINE h5tset_ebias_f + + SUBROUTINE h5tget_norm_f(type_id, norm, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: norm !mantissa normalization of a floating-point datatype + !Valid normalization types are: + !H5T_NORM_IMPLIED_F(0),MSB of mantissa is not + !stored, always 1, H5T_NORM_MSBSET_F(1), MSB of + !mantissa is always 1, H5T_NORM_NONE_F(2) + !Mantissa is not normalize + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_norm_c + hdferr = h5tget_norm_c(type_id, norm) + END SUBROUTINE h5tget_norm_f + + + SUBROUTINE h5tset_norm_f(type_id, norm, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: norm !mantissa normalization of a floating-point datatype + !Valid normalization types are: + !H5T_NORM_IMPLIED_F(0),MSB of mantissa is not + !stored, always 1, H5T_NORM_MSBSET_F(1), MSB of + !mantissa is always 1, H5T_NORM_NONE_F(2) + !Mantissa is not normalize + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_norm_c + hdferr = h5tset_norm_c(type_id, norm) + END SUBROUTINE h5tset_norm_f + + SUBROUTINE h5tget_inpad_f(type_id, padtype, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: padtype ! padding type for unused bits + ! in floating-point datatypes. + ! Possible values of padding type are: + ! H5T__PAD_ZERO_F = 0 + ! H5T__PAD_ONE_F = 1 + ! H5T__PAD_BACKGROUND_F = 2 + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_inpad_c + hdferr = h5tget_inpad_c(type_id, padtype) + END SUBROUTINE h5tget_inpad_f + + SUBROUTINE h5tset_inpad_f(type_id, padtype, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: padtype ! padding type for unused bits + ! in floating-point datatypes. + ! Possible values of padding type are: + ! H5T__PAD_ZERO_F = 0 + ! H5T__PAD_ONE_F = 1 + ! H5T__PAD_BACKGROUND_F = 2 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_inpad_c + hdferr = h5tset_inpad_c(type_id, padtype) + END SUBROUTINE h5tset_inpad_f + + SUBROUTINE h5tget_cset_f(type_id, cset, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: cset ! character set type of a string datatype + ! Possible values of padding type are: + !H5T_CSET_ASCII_F = 0 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_cset_c + hdferr = h5tget_cset_c(type_id, cset) + END SUBROUTINE h5tget_cset_f + + SUBROUTINE h5tset_cset_f(type_id, cset, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: cset !character set type of a string datatype + !Possible values of padding type are: + !H5T_CSET_ASCII_F = 0 + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_cset_c + hdferr = h5tset_cset_c(type_id, cset) + END SUBROUTINE h5tset_cset_f + + SUBROUTINE h5tget_strpad_f(type_id, strpad, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: strpad ! string padding method for a string datatype + ! Possible values of padding type are: + !Pad with zeros (as C does): H5T_STR_NULL_F(0), + !Pad with spaces (as FORTRAN does): + !H5T_STR_SPACE_F(1) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_strpad_c + hdferr = h5tget_strpad_c(type_id, strpad) + END SUBROUTINE h5tget_strpad_f + + SUBROUTINE h5tset_strpad_f(type_id, strpad, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: strpad ! string padding method for a string datatype + ! Possible values of padding type are: + !Pad with zeros (as C does): H5T_STR_NULL_F(0), + !Pad with spaces (as FORTRAN does): + !H5T_STR_SPACE_F(1) + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tset_strpad_c + hdferr = h5tset_strpad_c(type_id, strpad) + END SUBROUTINE h5tset_strpad_f + + + SUBROUTINE h5tget_nmembers_f(type_id, num_members, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: num_members !number of fields in a compound datatype + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_nmembers_c + hdferr = h5tget_nmembers_c(type_id, num_members) + END SUBROUTINE h5tget_nmembers_f + + SUBROUTINE h5tget_member_name_f(type_id,index, member_name, namelen, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: index !Field index (0-based) of the field name to retrieve + CHARACTER(LEN=*), INTENT(OUT) :: member_name !name of a field of + !a compound datatype + INTEGER, INTENT(OUT) :: namelen ! Length the name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_member_name_c + hdferr = h5tget_member_name_c(type_id, index, member_name, namelen) + END SUBROUTINE h5tget_member_name_f + + SUBROUTINE h5tget_member_offset_f(type_id, member_no, offset, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: member_no !Number of the field + !whose offset is requested + INTEGER(SIZE_T), INTENT(OUT) :: offset !byte offset of the the beginning of the field + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_member_offset_c + hdferr = h5tget_member_offset_c(type_id, member_no, offset ) + END SUBROUTINE h5tget_member_offset_f + + SUBROUTINE h5tget_member_dims_f(type_id, field_idx,dims, field_dims, perm, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: field_idx !Field index (0-based) of + !field_dims, perm) + INTEGER, INTENT(OUT) :: dims !number of dimensions of the field + + INTEGER(SIZE_T),DIMENSION(*), INTENT(OUT) :: field_dims !buffer to store the + !dimensions of the field + INTEGER, DIMENSION(*), INTENT(OUT) :: perm !buffer to store the + !permutation vector of the field + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_member_dims_c + hdferr = h5tget_member_dims_c(type_id, field_idx, dims, field_dims, perm) + + END SUBROUTINE h5tget_member_dims_f + + SUBROUTINE h5tget_member_type_f(type_id, field_idx, datatype, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: field_idx !Field index (0-based) of the field type to retrieve + INTEGER(HID_T), INTENT(OUT) :: datatype !identifier of a copy of + !the datatype of the field + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_member_type_c + hdferr = h5tget_member_type_c(type_id, field_idx , datatype) + END SUBROUTINE h5tget_member_type_f + + + SUBROUTINE h5tcreate_f(class, size, type_id, hdferr) + IMPLICIT NONE + INTEGER, INTENT(IN) :: class ! Datatype class cna be one of + ! H5T_COMPOUND_F (6) + ! H5T_ENUM_F (8) + ! H5T_OPAQUE_F (9) + INTEGER(SIZE_T), INTENT(IN) :: size ! Size of the datatype + INTEGER(HID_T), INTENT(OUT) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tcreate_c + + hdferr = h5tcreate_c(class, size, type_id) + END SUBROUTINE h5tcreate_f + + SUBROUTINE h5tinsert_f(type_id, name, offset, field_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the field to insert + INTEGER(SIZE_T), INTENT(IN) :: offset !Offset in memory structure of the field to insert + INTEGER(HID_T), INTENT(IN) :: field_id !datatype identifier of the new member + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5tinsert_c + namelen = LEN(name) + hdferr = h5tinsert_c(type_id, name, namelen, offset, field_id ) + END SUBROUTINE h5tinsert_f + + SUBROUTINE h5tpack_f(type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tpack_c + hdferr = h5tpack_c(type_id) + END SUBROUTINE h5tpack_f + + SUBROUTINE h5tinsert_array_f(parent_id,name,offset, ndims, dims, member_id, hdferr, perm) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: parent_id ! identifier of the parent compound datatype + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member + INTEGER(SIZE_T), INTENT(IN) :: offset !Offset to start of new member + !within compound datatype + INTEGER, INTENT(IN) :: ndims !Dimensionality of new member. + !Valid values are 0 (zero) through 4 (four) + INTEGER(SIZE_T), DIMENSION(*), INTENT(IN) :: dims !Size of new member array + INTEGER(HID_T), INTENT(IN) :: member_id ! identifier of the datatype of the new member + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER, DIMENSION(*), OPTIONAL, INTENT(IN) :: perm + !Pointer to buffer to store + !the permutation vector of the field + INTEGER :: namelen, sizeofperm + INTEGER, EXTERNAL :: h5tinsert_array_c, h5tinsert_array_c2 + namelen = LEN(name) + if (present(perm)) then + hdferr = h5tinsert_array_c(parent_id, name, namelen, offset, ndims,dims, member_id, perm) + else + hdferr = h5tinsert_array_c2(parent_id, name, namelen, offset, ndims,dims, member_id) + end if + + END SUBROUTINE h5tinsert_array_f + + SUBROUTINE h5tenum_create_f(parent_id, new_type_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: parent_id ! Datatype identifier for + ! the base datatype + INTEGER(HID_T), INTENT(OUT) :: new_type_id + !datatype identifier for the + ! new enumeration datatype + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tenum_create_c + hdferr = h5tenum_create_c(parent_id, new_type_id) + END SUBROUTINE h5tenum_create_f + + SUBROUTINE h5tenum_insert_f(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member + INTEGER, INTENT(IN) :: value !value of the new member + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5tenum_insert_c + namelen = LEN(name) + hdferr = h5tenum_insert_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f + + SUBROUTINE h5tenum_nameof_f(type_id, name, namelen, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(OUT) :: name !Name of the enumeration datatype. + INTEGER(SIZE_T), INTENT(IN) :: namelen !length of the name + INTEGER, INTENT(IN) :: value !value of the enumeration datatype. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tenum_nameof_c + hdferr = h5tenum_nameof_c(type_id, value, name, namelen) + END SUBROUTINE h5tenum_nameof_f + + SUBROUTINE h5tenum_valueof_f(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the enumeration datatype. + INTEGER, INTENT(OUT) :: value !value of the enumeration datatype. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5tenum_valueof_c + namelen = LEN(name) + hdferr = h5tenum_valueof_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_valueof_f + + SUBROUTINE h5tget_member_value_f(type_id, member_no, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(IN) :: member_no !Number of the enumeration datatype member + INTEGER, INTENT(OUT) :: value !value of the enumeration datatype. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_member_value_c + hdferr = h5tget_member_value_c(type_id, member_no, value) + END SUBROUTINE h5tget_member_value_f + + SUBROUTINE h5tset_tag_f(type_id, tag, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: tag !Unique ASCII string with which + !the opaque datatype is to be tagged + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: namelen + INTEGER, EXTERNAL :: h5tset_tag_c + namelen = LEN(tag) + hdferr = h5tset_tag_c(type_id, tag, namelen) + END SUBROUTINE h5tset_tag_f + + SUBROUTINE h5tget_tag_f(type_id, tag,taglen, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(OUT) :: tag !Unique ASCII string with which + !the opaque datatype is to be tagged + INTEGER, INTENT(OUT) :: taglen !length of tag + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, EXTERNAL :: h5tget_tag_c + hdferr = h5tget_tag_c(type_id, tag, taglen) + END SUBROUTINE h5tget_tag_f + + END MODULE H5T diff --git a/fortran/src/H5f90.h b/fortran/src/H5f90.h new file mode 100644 index 0000000..c01cd1f --- /dev/null +++ b/fortran/src/H5f90.h @@ -0,0 +1,77 @@ +#ifndef _H5f90_H +#define _H5f90_H + +#include <hdf5.h> +#include "H5f90i.h" +#include "H5f90proto.h" + + +/* Constants from the H5Ff.c and H5Fff.f90 files */ + + +#define H5F_ACC_RDWR_F 1 +#define H5F_ACC_RDONLY_F 2 +#define H5F_ACC_TRUNC_F 3 +#define H5F_ACC_EXCL_F 4 +#define H5F_ACC_DEBUG_F 5 +#define H5P_DEFAULT_F 6 /* Can Fortran program use combination + of those flags? */ +#define H5F_SCOPE_LOCAL_F 0 +#define H5F_SCOPE_GLOBAL_F 1 + +/* Constants used in the H5Gf.c and H5Gff.f90 files */ + +#define OBJECT_NAMELEN_DEFAULT_F -1 +#define H5G_LINK_F 0 +#define H5G_GROUP_F 1 +#define H5G_DATASET_F 2 +#define H5G_TYPE_F 3 + + +/* Constants used in H5Df.c and H5Dff.f90 files */ + +#define H5S_ALL_F -2 + +/* Constants used in H5Sf.c and H5Sff.f90 files */ + +#define H5S_NO_CLASS_F -1 +#define H5S_SCALAR_F 0 +#define H5S_SIMPLE_F 1 +#define H5S_SELECT_SET_F 0 +#define H5S_SELECT_OR_F 1 + +/* Constants ised in H5Tf.c and H5Tff.f90 files */ + + +#define H5T_NO_CLASS_F -1 +#define H5T_INTEGER_F 0 +#define H5T_FLOAT_F 1 +#define H5T_TIME_F 2 +#define H5T_STRING_F 3 +#define H5T_BITFIELD_F 4 +#define H5T_OPAQUE_F 5 +#define H5T_COMPOUND_F 6 +#define H5T_REFERENCE_F 7 +#define H5T_ENUM_F 8 + +#define H5T_ORDER_LE_F 0 +#define H5T_ORDER_BE_F 1 +#define H5T_ORDER_VAX_F 2 + + +/* Constants used in H5Pf.c and H5Pff.f90 files */ + + +#define H5P_NO_CLASS_F -1 +#define H5P_FILE_CREATE_F 0 +#define H5P_FILE_ACCESS_F 1 +#define H5P_DATASET_CREATE_F 2 +#define H5P_DATASET_XFER_F 3 +#define H5P_MOUNT_F 4 + +/* Constants used in H5Pf_parallel.c and H5Pff_parallel.f90 files */ +#define H5D_XFER_INDEPENDENT_F 0 +#define H5D_XFER_COLLECTIVE_F 1 +#define H5D_XFER_DFLT_F 2 + +#endif /* _H5f90_H */ diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 new file mode 100644 index 0000000..078870b --- /dev/null +++ b/fortran/src/H5f90global.f90 @@ -0,0 +1,105 @@ + MODULE H5GLOBAL + USE H5FORTRAN_TYPES + INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 6 ! Do not forget to change this + ! value when new predefined + ! datatypes are added + ! Do not forget to change the following line when new predefined + ! floating data types are added + INTEGER, PARAMETER :: FLOATING_TYPES_LEN = 4 + + ! Do not forget to change the following line when new predefined + ! integer data types are added + INTEGER, PARAMETER :: INTEGER_TYPES_LEN = 16 + + INTEGER(HID_T) H5T_NATIVE_INTEGER, & + H5T_NATIVE_REAL, & + H5T_NATIVE_DOUBLE, & + H5T_NATIVE_CHARACTER , & + H5T_STD_REF_OBJ, & + H5T_STD_REF_DSETREG, & + H5T_IEEE_F32BE, & + H5T_IEEE_F32LE, & + H5T_IEEE_F64BE, & + H5T_IEEE_F64LE, & + H5T_STD_I8BE, & + H5T_STD_I8LE, & + H5T_STD_I16BE, & + H5T_STD_I16LE, & + H5T_STD_I32BE, & + H5T_STD_I32LE, & + H5T_STD_I64BE, & + H5T_STD_I64LE, & + H5T_STD_U8BE, & + H5T_STD_U8LE, & + H5T_STD_U16BE, & + H5T_STD_U16LE, & + H5T_STD_U32BE, & + H5T_STD_U32LE, & + H5T_STD_U64BE, & + H5T_STD_U64LE + + + INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: predef_types + EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER) + EQUIVALENCE (predef_types(2), H5T_NATIVE_REAL) + EQUIVALENCE (predef_types(3), H5T_NATIVE_DOUBLE) + EQUIVALENCE (predef_types(4), H5T_NATIVE_CHARACTER) + EQUIVALENCE (predef_types(5), H5T_STD_REF_OBJ) + EQUIVALENCE (predef_types(6), H5T_STD_REF_DSETREG) + + INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: floating_types + EQUIVALENCE (floating_types(1), H5T_IEEE_F32BE ) + EQUIVALENCE (floating_types(2), H5T_IEEE_F32LE) + EQUIVALENCE (floating_types(3), H5T_IEEE_F64BE) + EQUIVALENCE (floating_types(4), H5T_IEEE_F64LE) + + INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: integer_types + EQUIVALENCE (integer_types(1), H5T_STD_I8BE ) + EQUIVALENCE (integer_types(2), H5T_STD_I8LE) + EQUIVALENCE (integer_types(3), H5T_STD_I16BE) + EQUIVALENCE (integer_types(4), H5T_STD_I16LE) + EQUIVALENCE (integer_types(5), H5T_STD_I32BE) + EQUIVALENCE (integer_types(6), H5T_STD_I32LE) + EQUIVALENCE (integer_types(7), H5T_STD_I64BE) + EQUIVALENCE (integer_types(8), H5T_STD_I64LE) + EQUIVALENCE (integer_types(9), H5T_STD_U8BE) + EQUIVALENCE (integer_types(10), H5T_STD_U8LE) + EQUIVALENCE (integer_types(11), H5T_STD_U16BE) + EQUIVALENCE (integer_types(12), H5T_STD_U16LE) + EQUIVALENCE (integer_types(13), H5T_STD_U32BE) + EQUIVALENCE (integer_types(14), H5T_STD_U32LE) + EQUIVALENCE (integer_types(15), H5T_STD_U64BE) + EQUIVALENCE (integer_types(16), H5T_STD_U64LE) + + + COMMON /PREDEFINED_TYPES/ H5T_NATIVE_INTEGER, & + H5T_NATIVE_REAL, & + H5T_NATIVE_DOUBLE, & + H5T_NATIVE_CHARACTER, & + H5T_STD_REF_OBJ, & + H5T_STD_REF_DSETREG + + COMMON /FLOATING_TYPES/ H5T_IEEE_F32BE, & + H5T_IEEE_F32LE, & + H5T_IEEE_F64BE, & + H5T_IEEE_F64LE + + COMMON /INTEGER_TYPES/ H5T_STD_I8BE, & + H5T_STD_I8LE, & + H5T_STD_I16BE, & + H5T_STD_I16LE, & + H5T_STD_I32BE, & + H5T_STD_I32LE, & + H5T_STD_I64BE, & + H5T_STD_I64LE, & + H5T_STD_U8BE, & + H5T_STD_U8LE, & + H5T_STD_U16BE, & + H5T_STD_U16LE, & + H5T_STD_U32BE, & + H5T_STD_U32LE, & + H5T_STD_U64BE, & + H5T_STD_U64LE + + END MODULE H5GLOBAL + diff --git a/fortran/src/H5f90i.h b/fortran/src/H5f90i.h new file mode 100644 index 0000000..9d19ef4 --- /dev/null +++ b/fortran/src/H5f90i.h @@ -0,0 +1,286 @@ +#ifndef _H5f90i_H +#define _H5f90i_H + +#ifdef GOT_MACHINE +#undef GOT_MACHINE +#endif + +#define DFMT_IRIX 0x1111 + +/* + * Standard header files needed all the time + */ + +#include <stdio.h> +#include <stdlib.h> +#include <limits.h> +#include <string.h> + +#if (defined (UNICOS) || (defined (_UNICOS))) + +#ifndef UNICOS +#define UNICOS +#endif + +#include <memory.h> +#include <fortran.h> +#ifndef O_RDONLY +#include <fcntl.h> /* for unbuffered i/o stuff */ +#define L_INCR 1 +#include <sys/stat.h> +#endif /*O_RDONLY*/ + +#ifdef _CRAYIEEE +#define DF_MT DFMT_UNICOSIEEE +#else +#define DF_MT DFMT_UNICOS +#endif +/*typedef char* _fcd;*/ +typedef long hsize_t_f; +typedef long hssize_t_f; +typedef long size_t_f; +typedef long int_f; +typedef long hid_t_f; +typedef double real_f; +#define DF_CAPFNAMES +/*#define _fcdtocp(desc) (desc)*/ + +#endif /* UNICOS */ + + +/* LINUX definitions */ +#if defined(i386) && defined(linux) +#define DF_MT DFMT_LINIX +typedef char *_fcd; +typedef long long hsize_t_f; +typedef long long hssize_t_f; +typedef int size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; +#define FNAME_POST_UNDERSCORE +#define _fcdtocp(desc) (desc) + +#endif /*LINUX*/ + +#if defined(IRIX) || defined(IRIS4) || defined(sgi) || defined(__sgi__) || defined(__sgi) + +#ifndef IRIX +#define IRIX +#endif + +#if (_MIPS_SZLONG == 64) +/* IRIX 64 bits objects. It is nearly the same as the conventional + * 32 bits objects. Let them share IRIX definitions for now. + */ +#define IRIX64 +#endif + + +#ifdef GOT_MACHINE +If you get an error on this line more than one machine type has been defined. +Please check your Makefile. +#endif +#define GOT_MACHINE 1 + +# define BSD +#ifndef __GNUC__ +#include <memory.h> +#endif /* __GNUC__ */ +#include <sys/file.h> /* for unbuffered i/o stuff */ +#include <sys/stat.h> +#define DF_MT DFMT_IRIX +typedef char *_fcd; + +typedef long hsize_t_f; +typedef long hssize_t_f; +typedef long size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; +#define FNAME_POST_UNDERSCORE +#define _fcdtocp(desc) (desc) +#ifdef IRIX64 +#define BIG_LONGS +#endif + + +#define HAVE_STDC +#define INCLUDES_ARE_ANSI + +#endif /* IRIX */ + +#if (defined(SUN) || defined(sun) || defined(__sun__) || defined(__SUNPRO_C)) & !defined(__i386) +#ifdef __STDC__ +#define ANSISUN +#else /* __STDC__ */ +#define KNRSUN +#endif /* __STDC__ */ +#endif /* SUN || sun */ + +#if defined(ANSISUN) + +#if !defined(SUN) +#define SUN +#endif + +#ifdef GOT_MACHINE +If you get an error on this line more than one machine type has been defined. +Please check your Makefile. +#endif +#define GOT_MACHINE + +#include <unistd.h> /* for some file I/O stuff */ +#include <sys/time.h> +#include <sys/file.h> /* for unbuffered i/o stuff */ +#include <sys/stat.h> +#define DF_MT DFMT_SUN +typedef char *_fcd; +typedef int hsize_t_f; +typedef int hssize_t_f; +typedef int size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; +#define FNAME_POST_UNDERSCORE +#define _fcdtocp(desc) (desc) + +#endif /*SUN*/ + + +#if defined DEC_ALPHA || (defined __alpha && defined __unix__) + +#ifndef DEC_ALPHA +#define DEC_ALPHA +#endif + +#ifdef GOT_MACHINE +If you get an error on this line more than one machine type has been defined. +Please check your Makefile. +#endif +#define GOT_MACHINE + +#include <sys/file.h> /* for unbuffered i/o stuff */ +#include <sys/stat.h> +#define DF_MT DFMT_ALPHA +typedef char *_fcd; +typedef long hsize_t_f; +typedef long hssize_t_f; +typedef long size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; +#define FNAME_POST_UNDERSCORE +#define _fcdtocp(desc) (desc) + +#endif /* DEC_ALPHA */ + + +#if defined(HP9000) || (!defined(__convexc__) && (defined(hpux) || defined(__hpux))) + +#ifndef HP9000 +#define HP9000 +#endif + +#ifdef GOT_MACHINE +If you get an error on this line more than one machine type has been defined. +Please check your Makefile. +#endif +#define GOT_MACHINE + +#ifndef HAVE_UNISTD_H +#define HAVE_UNISTD_H /* unistd.h - close, fork,..etc */ +#endif + +# define BSD +#ifndef __GNUC__ +#include <memory.h> +#endif /* __GNUC__ */ +#include <sys/file.h> /* for unbuffered i/o stuff */ +#include <sys/stat.h> +#define DF_MT DFMT_HP9000 +typedef char *_fcd; +typedef long hsize_t_f; +typedef long hssize_t_f; +typedef long size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; +#define _fcdtocp(desc) (desc) +#ifdef HAVE_FMPOOL +#define FILELIB PAGEBUFIO /* enable page buffering */ +#else +#define FILELIB UNIXBUFIO +#endif + +#endif /* HP9000 */ + + +#if defined _WINDOWS || defined WIN32 +#define GOT_MACHINE 1 + +#pragma comment( lib, "oldnames" ) +#include <fcntl.h> +#include <sys\types.h> +#include <sys\stat.h> +#include <io.h> +#include <conio.h> +#include <malloc.h> +#include <ctype.h> /* for character macros */ +#ifdef __WATCOMC__ +#include <stddef.h> /* for the 'fortran' pragma */ +#endif + +#define DF_MT DFMT_PC + +typedef char *_fcd; +typedef int hsize_t_f; +typedef int hssize_t_f; +typedef int size_t_f; +typedef int int_f; +typedef int hid_t_f; +typedef float real_f; + +#if defined _M_ALPHA +#define FNAME_PRE_UNDERSCORE +#endif + +#define DF_CAPFNAMES +#define _fcdtocp(desc) (desc) + +#ifdef HAVE_FMPOOL +#define FILELIB PAGEBUFIO /* enable page buffering */ +#else +#define FILELIB UNIXBUFIO +#endif + +#endif /*WINDOWS */ + +/*---------------------------------------------------------------- +** MACRO FNAME for any fortran callable routine name. +** +** This macro prepends, appends, or does not modify a name +** passed as a macro parameter to it based on the FNAME_PRE_UNDERSCORE, +** FNAME_POST_UNDERSCORE macros set for a specific system. +** +**---------------------------------------------------------------*/ +#if defined(FNAME_PRE_UNDERSCORE) && defined(FNAME_POST_UNDERSCORE) +# define FNAME(x) _##x##_ +#endif +#if defined(FNAME_PRE_UNDERSCORE) && !defined(FNAME_POST_UNDERSCORE) +# define FNAME(x) _##x +#endif +#if !defined(FNAME_PRE_UNDERSCORE) && defined(FNAME_POST_UNDERSCORE) +# define FNAME(x) x##_ +#endif +#if !defined(FNAME_PRE_UNDERSCORE) && !defined(FNAME_POST_UNDERSCORE) +# define FNAME(x) x +#endif + +# define HDfree(p) (free((void*)p)) +# define HDmalloc(s) (malloc((size_t)s)) +# define HDstrlen(s) (strlen((const char *)(s))) +# define HDmemcpy(dst,src,n) (memcpy((void *)(dst),(const void *)(src),(size_t)(n))) + + +#endif /* _H5f90i_H */ diff --git a/fortran/src/H5f90kit.c b/fortran/src/H5f90kit.c new file mode 100644 index 0000000..a0a6962 --- /dev/null +++ b/fortran/src/H5f90kit.c @@ -0,0 +1,105 @@ +#include <ctype.h> +#include <stddef.h> +#include "H5f90.h" + + +/* + * Routines from HDF4 to deal with C-FORTRAN issues. + * + * HD5c2fstr -- convert a C string into a Fortran string IN PLACE + * HD5f2cstring -- convert a Fortran string to a C string + */ + +/* ------------------------------- HDc2fstr ------------------------------- +NAME + HD5c2fstr -- convert a C string into a Fortran string IN PLACE +USAGE + int HD5c2fstr(str, len) + char * str; IN: string to convert + int len; IN: length of Fortran string +RETURNS + SUCCEED +DESCRIPTION + Change a C string (NULL terminated) into a Fortran string. + Basically, all that is done is that the NULL is ripped out + and the string is padded with spaces + +---------------------------------------------------------------------------*/ +int +HD5c2fstr(char *str, int len) +{ + int i; + + i=(int)HDstrlen(str); + for (; i < len; i++) + str[i] = ' '; + return 0; +} /* HD5c2fstr */ + +/* ----------------------------- HDf2cstring ------------------------------ */ +/* +NAME + HD5f2cstring -- convert a Fortran string to a C string +USAGE + char * HDf2cstring(fdesc, len) + _fcd fdesc; IN: Fortran string descriptor + int len; IN: length of Fortran string +RETURNS + Pointer to the C string if success, else NULL +DESCRIPTION + Chop off trailing blanks off of a Fortran string and + move it into a newly allocated C string. It is up + to the user to free this string. + +---------------------------------------------------------------------------*/ +char * +HD5f2cstring(_fcd fdesc, int len) +{ + char *cstr, *str; + int i; + + str = _fcdtocp(fdesc); + /* This should be equivalent to the above test -QAK */ + for(i=len-1; i>=0 && !isgraph((int)str[i]); i--) + /*EMPTY*/; + cstr = (char *) HDmalloc( (i + 2)); + if (!cstr) return NULL; + cstr[i + 1] = '\0'; + HDmemcpy(cstr,str,i+1); + return cstr; +} /* HD5f2cstring */ + +/* ---------------------------- HDpackFstring ----------------------------- */ +/* +NAME + HDpackFstring -- convert a C string into a Fortran string +USAGE + intn HDpackFstring(src, dest, len) + char * src; IN: source string + char * dest; OUT: destination + intn len; IN: length of string +RETURNS + SUCCEED / FAIL +DESCRIPTION + given a NULL terminated C string 'src' convert it to + a space padded Fortran string 'dest' of length 'len' + + This is very similar to HDc2fstr except that function does + it in place and this one copies. We should probably only + support one of these. + +---------------------------------------------------------------------------*/ +int +HDpackFstring(char *src, char *dest, int len) +{ + int sofar; + + for (sofar = 0; (sofar < len) && (*src != '\0'); sofar++) + *dest++ = *src++; + + while (sofar++ < len) + *dest++ = ' '; + + return 0; +} /* HDpackFstring */ + diff --git a/fortran/src/H5f90misc.c b/fortran/src/H5f90misc.c new file mode 100644 index 0000000..728b50a --- /dev/null +++ b/fortran/src/H5f90misc.c @@ -0,0 +1,139 @@ +#include "H5f90.h" + +/*--------------------------------------------------------------------------- + * Name: h5init_types_c + * Purpose: Initialize predefined datatypes in Fortran + * Inputs: types - array with the predefined Native Fortran + * type, its element and length must be the + * same as the types array defined in the + * H5f90global.f90 + * floatingtypes - array with the predefined Floating Fortran + * type, its element and length must be the + * same as the floatingtypes array defined in the + * H5f90global.f90 + * integertypes - array with the predefined Integer Fortran + * type, its element and length must be the + * same as the integertypes array defined in the + * H5f90global.f90 + * Outputs: None + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes ) +{ + + int ret_value = -1; + hid_t c_type_id; + if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value; +#if defined(_UNICOS) + if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value; +#else + if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value; +#endif + if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value; +/* + if ((types[3] = H5Tcopy(H5T_NATIVE_UINT8)) < 0) return ret_value; +*/ + if ((c_type_id = H5Tcopy(H5T_FORTRAN_S1)) < 0) return ret_value; + if(H5Tset_size(c_type_id, 1) < 0) return ret_value; + if(H5Tset_strpad(c_type_id, H5T_STR_SPACEPAD) < 0) return ret_value; + types[3] = (hid_t_f)c_type_id; + + + +/* + if ((types[3] = H5Tcopy(H5T_C_S1)) < 0) return ret_value; + if(H5Tset_strpad(types[3],H5T_STR_NULLTERM) < 0) return ret_value; + if(H5Tset_size(types[3],1) < 0) return ret_value; +*/ + + +/* if ((types[3] = H5Tcopy(H5T_STD_I8BE)) < 0) return ret_value; +*/ + if ((types[4] = (hid_t_f)H5Tcopy(H5T_STD_REF_OBJ)) < 0) return ret_value; + if ((types[5] = (hid_t_f)H5Tcopy(H5T_STD_REF_DSETREG)) < 0) return ret_value; + + if ((floatingtypes[0] = (hid_t_f)H5Tcopy(H5T_IEEE_F32BE)) < 0) return ret_value; + if ((floatingtypes[1] = (hid_t_f)H5Tcopy(H5T_IEEE_F32LE)) < 0) return ret_value; + if ((floatingtypes[2] = (hid_t_f)H5Tcopy(H5T_IEEE_F64BE)) < 0) return ret_value; + if ((floatingtypes[3] = (hid_t_f)H5Tcopy(H5T_IEEE_F64LE)) < 0) return ret_value; + + if ((integertypes[0] = (hid_t_f)H5Tcopy(H5T_STD_I8BE)) < 0) return ret_value; + if ((integertypes[1] = (hid_t_f)H5Tcopy(H5T_STD_I8LE)) < 0) return ret_value; + if ((integertypes[2] = (hid_t_f)H5Tcopy(H5T_STD_I16BE)) < 0) return ret_value; + if ((integertypes[3] = (hid_t_f)H5Tcopy(H5T_STD_I16LE)) < 0) return ret_value; + if ((integertypes[4] = (hid_t_f)H5Tcopy(H5T_STD_I32BE)) < 0) return ret_value; + if ((integertypes[5] = (hid_t_f)H5Tcopy(H5T_STD_I32LE)) < 0) return ret_value; + if ((integertypes[6] = (hid_t_f)H5Tcopy(H5T_STD_I64BE)) < 0) return ret_value; + if ((integertypes[7] = (hid_t_f)H5Tcopy(H5T_STD_I64LE)) < 0) return ret_value; + if ((integertypes[8] = (hid_t_f)H5Tcopy(H5T_STD_U8BE)) < 0) return ret_value; + if ((integertypes[9] = (hid_t_f)H5Tcopy(H5T_STD_U8LE)) < 0) return ret_value; + if ((integertypes[10] = (hid_t_f)H5Tcopy(H5T_STD_U16BE)) < 0) return ret_value; + if ((integertypes[11] = (hid_t_f)H5Tcopy(H5T_STD_U16LE)) < 0) return ret_value; + if ((integertypes[12] = (hid_t_f)H5Tcopy(H5T_STD_U32BE)) < 0) return ret_value; + if ((integertypes[13] = (hid_t_f)H5Tcopy(H5T_STD_U32LE)) < 0) return ret_value; + if ((integertypes[14] = (hid_t_f)H5Tcopy(H5T_STD_U64BE)) < 0) return ret_value; + if ((integertypes[15] = (hid_t_f)H5Tcopy(H5T_STD_U64LE)) < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*--------------------------------------------------------------------------- + * Name: h5close_types_c + * Purpose: Closes predefined datatype in Fortran + * Inputs: types - array with the predefined Native Fortran + * type, its element and length must be the + * same as the types array defined in the + * H5f90global.f90 + * lentypes - length of the types array, which must be the + * same as the length of types array defined + * in the H5f90global.f90 + * floatingtypes - array with the predefined Floating Fortran + * type, its element and length must be the + * same as the floatingtypes array defined in the + * H5f90global.f90 + * floatinglen - length of the floatingtypes array, which must be the + * same as the length of floatingtypes array defined + * in the H5f90global.f90 + * integertypes - array with the predefined Integer Fortran + * type, its element and length must be the + * same as the integertypes array defined in the + * H5f90global.f90 + * integerlen - length of the floatingtypes array, which must be the + * same as the length of floatingtypes array defined + * in the H5f90global.f90 + * Outputs: None + * Returns: 0 on success, -1 on failure + * Programmer: Elena Pourmal + * Tuesday, August 3, 1999 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5close_types_c( hid_t_f * types, int_f *lentypes, + hid_t_f * floatingtypes, int_f* floatinglen, + hid_t_f * integertypes, int_f * integerlen ) +{ + + int ret_value = -1; + hid_t c_type_id; + herr_t err; + int i; + for (i = 0; i < *lentypes; i++) { + c_type_id = types[i]; + if ( (err = H5Tclose(c_type_id)) < 0) return ret_value; + } + for (i = 0; i < *floatinglen; i++) { + c_type_id = floatingtypes[i]; + if ( (err = H5Tclose(c_type_id)) < 0) return ret_value; + } + for (i = 0; i < *integerlen; i++) { + c_type_id = integertypes[i]; + if ( (err = H5Tclose(c_type_id)) < 0) return ret_value; + } + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5f90miscf.f90 b/fortran/src/H5f90miscf.f90 new file mode 100644 index 0000000..a345019 --- /dev/null +++ b/fortran/src/H5f90miscf.f90 @@ -0,0 +1,22 @@ + SUBROUTINE h5init_types_f(error) + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTEGER, EXTERNAL :: h5init_types_c + error = h5init_types_c(predef_types, floating_types, integer_types) + + END SUBROUTINE h5init_types_f + + SUBROUTINE h5close_types_f(error) + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTEGER, EXTERNAL :: h5close_types_c + error = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & + floating_types, FLOATING_TYPES_LEN, & + integer_types, INTEGER_TYPES_LEN ) + + END SUBROUTINE h5close_types_f + diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h new file mode 100644 index 0000000..f759038 --- /dev/null +++ b/fortran/src/H5f90proto.h @@ -0,0 +1,872 @@ +#ifndef _H5f90proto_H +#define _H5f90proto_H + +#include "H5Git.h" +extern int HD5c2fstr(char *str, int len); +extern char * HD5fcstring (_fcd fdesc, int len); +extern int HDpackFstring(char *src, char *dest, int len); + +/* + * Functions from H5Ff.c + */ +#ifndef H5Ff90_FNAMES +# define H5Ff90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5fcreate_c FNAME(H5FCREATE_C) +# define nh5fflush_c FNAME(H5FFLUSH_C) +# define nh5fclose_c FNAME(H5FCLOSE_C) +# define nh5fopen_c FNAME(H5FOPEN_C) +# define nh5fis_hdf5_c FNAME(H5FIS_HDF5_C) +# define nh5fmount_c FNAME(H5FMOUNT_C) +# define nh5funmount_c FNAME(H5FUNMOUNT_C) +# define nh5freopen_c FNAME(H5FREOPEN_C) +# define nh5fget_create_plist_c FNAME(H5FGET_CREATE_PLIST_C) +# define nh5fget_access_plist_c FNAME(H5FGET_ACCESS_PLIST_C) +#else /* !DF_CAPFNAMES */ +# define nh5fcreate_c FNAME(h5fcreate_c) +# define nh5fflush_c FNAME(h5fflush_c) +# define nh5fclose_c FNAME(h5fclose_c) +# define nh5fopen_c FNAME(h5fopen_c) +# define nh5fis_hdf5_c FNAME(h5fis_hdf5_c) +# define nh5fmount_c FNAME(h5fmount_c) +# define nh5funmount_c FNAME(h5funmount_c) +# define nh5freopen_c FNAME(h5freopen_c) +# define nh5fget_create_plist_c FNAME(h5fget_create_plist_c) +# define nh5fget_access_plist_c FNAME(h5fget_access_plist_c) +#endif /* DF_CAPFNAMES */ +#endif /* H5Ff90_FNAMES */ + +extern int_f nh5fcreate_c +(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *crt_prp, hid_t_f *acc_prp, hid_t_f *file_id); + +extern int_f nh5fopen_c +(_fcd name, int_f *namelen, int_f *access_flags, hid_t_f *acc_prp, hid_t_f *file_id); + +extern int_f nh5fis_hdf5_c +(_fcd name, int_f *namelen, int_f *flag); + +extern int_f nh5fclose_c (hid_t_f *file_id); +extern int_f nh5fmount_c +(hid_t_f *loc_id, _fcd dsetname, int_f *namelen, hid_t_f *file_id, hid_t_f *acc_prp); +extern int_f nh5funmount_c +(hid_t_f *loc_id, _fcd dsetname, int_f *namelen); +extern int_f nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2); +extern int_f nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id); +extern int_f nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id); +/* + * Functions from H5Sf.c + */ +#ifndef H5Sf90_FNAMES +# define H5Sf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5screate_simple_c FNAME(H5SCREATE_SIMPLE_C) +# define nh5sclose_c FNAME(H5SCLOSE_C) +# define nh5screate_c FNAME(H5SCREATE_C) +# define nh5scopy_c FNAME(H5SCOPY_C) +# define nh5sget_select_hyper_nblocks_c FNAME(H5SGET_SELECT_HYPER_NBLOCKS_C) +# define nh5sget_select_hyper_blocklist_c FNAME(H5SGET_SELECT_HYPER_BLOCKLIST_C) +# define nh5sget_select_elem_npoints_c FNAME(H5SGET_SELECT_ELEM_NPOINTS_C) +# define nh5sget_select_elem_pointlist_c FNAME(H5SGET_SELECT_ELEM_POINTLIST_C) +# define nh5sget_select_bounds_c FNAME(H5SGET_SELECT_BOUNDS_C) +# define nh5sselect_all_c FNAME(H5SSELECT_ALL_C) +# define nh5sselect_none_c FNAME(H5SSELECT_NONE_C) +# define nh5sselect_valid_c FNAME(H5SSELECT_VALID_C) +# define nh5sget_simple_extent_npoints_c FNAME(H5SGET_SIMPLE_EXTENT_NPOINTS_C) +# define nh5sget_select_npoints_c FNAME(H5SGET_SELECT_NPOINTS_C) +# define nh5sget_simple_extent_ndims_c FNAME(H5SGET_SIMPLE_EXTENT_NDIMS_C) +# define nh5sget_simple_extent_type_c FNAME(H5SGET_SIMPLE_EXTENT_TYPE_C) +# define nh5soffset_simple_c FNAME(H5SOFFSET_SIMPLE_C) +# define nh5sset_extent_simple_c FNAME(H5SSET_EXTENT_SIMPLE_C) +# define nh5sis_simple_c FNAME(H5SIS_SIMPLE_C) +# define nh5sextent_class_c FNAME(H5SEXTENT_CLASS_C) +# define nh5sget_simple_extent_dims_c FNAME(H5SGET_SIMPLE_EXTENT_DIMS_C) +# define nh5sextent_copy_c FNAME(H5SEXTENT_COPY_C) +# define nh5sset_extent_none_c FNAME(H5SSET_EXTENT_NONE_C) +# define nh5sselect_hyperslab_c FNAME(H5SSELECT_HYPERSLAB_C) +# define nh5sselect_elements_c FNAME(H5SSELECT_ELEMENTS_C) +#else /* !DF_CAPFNAMES */ +# define nh5screate_simple_c FNAME(h5screate_simple_c) +# define nh5sclose_c FNAME(h5sclose_c) +# define nh5screate_c FNAME(h5screate_c) +# define nh5scopy_c FNAME(h5scopy_c) +# define nh5sget_select_hyper_nblocks_c FNAME(h5sget_select_hyper_nblocks_c) +# define nh5sget_select_hyper_blocklist_c FNAME(h5sget_select_hyper_blocklist_c) +# define nh5sget_select_elem_npoints_c FNAME(h5sget_select_elem_npoints_c) +# define nh5sget_select_bounds_c FNAME(h5sget_select_bounds_c) +# define nh5sget_select_elem_pointlist_c FNAME(h5sget_select_elem_pointlist_c) +# define nh5sselect_all_c FNAME(h5sselect_all_c) +# define nh5sselect_none_c FNAME(h5sselect_none_c) +# define nh5sselect_valid_c FNAME(h5sselect_valid_c) +# define nh5sget_simple_extent_npoints_c FNAME(h5sget_simple_extent_npoints_c) +# define nh5sget_select_npoints_c FNAME(h5sget_select_npoints_c) +# define nh5sget_simple_extent_ndims_c FNAME(h5sget_simple_extent_ndims_c) +# define nh5sget_simple_extent_type_c FNAME(h5sget_simple_extent_type_c) +# define nh5soffset_simple_c FNAME(h5soffset_simple_c) +# define nh5sset_extent_simple_c FNAME(h5sset_extent_simple_c) +# define nh5sis_simple_c FNAME(h5sis_simple_c) +# define nh5sextent_class_c FNAME(h5sextent_class_c) +# define nh5sget_simple_extent_dims_c FNAME(h5sget_simple_extent_dims_c) +# define nh5sextent_copy_c FNAME(h5sextent_copy_c) +# define nh5sset_extent_none_c FNAME(h5sset_extent_none_c) +# define nh5sselect_hyperslab_c FNAME(h5sselect_hyperslab_c) +# define nh5sselect_elements_c FNAME(h5sselect_elements_c) +#endif /* DF_CAPFNAMES */ +#endif + +extern int_f nh5screate_simple_c +( int_f *rank, hsize_t_f *dims, hsize_t_f *maxdims, hid_t_f *space_id ); + +extern int_f nh5sclose_c ( hid_t_f *space_id ); + +extern int_f nh5screate_c ( int_f *classtype, hid_t_f *space_id ); + +extern int_f nh5scopy_c ( hid_t_f *space_id , hid_t_f *new_space_id); +extern int_f nh5sget_select_hyper_nblocks_c( hid_t_f *space_id , hssize_t_f * num_blocks); +extern int_f nh5sget_select_hyper_blocklist_c( hid_t_f *space_id ,hsize_t_f * startblock, hsize_t_f * num_blocks, hsize_t_f * buf); + +extern int_f nh5sget_select_bounds_c( hid_t_f *space_id , hsize_t_f * start, hsize_t_f * end); + +extern int_f nh5sget_select_elem_npoints_c( hid_t_f *space_id , hssize_t_f * num_points); + +extern int_f nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint, hsize_t_f * numpoints, hsize_t_f * buf); +extern int_f nh5sselect_all_c ( hid_t_f *space_id ); + +extern int_f nh5sselect_none_c ( hid_t_f *space_id ); + +extern int_f nh5sselect_valid_c ( hid_t_f *space_id , int_f *flag ); + +extern int_f nh5sget_simple_extent_npoints_c ( hid_t_f *space_id , hsize_t_f *npoints ); + +extern int_f nh5sget_select_npoints_c ( hid_t_f *space_id , hssize_t_f *npoints ); + +extern int_f nh5sget_simple_extent_ndims_c ( hid_t_f *space_id , int_f *ndims ); + +extern int_f nh5sget_simple_extent_type_c ( hid_t_f *space_id , int_f *classtype); + +extern int_f nh5soffset_simple_c ( hid_t_f *space_id , hssize_t_f *offset); + +extern int_f nh5sset_extent_simple_c ( hid_t_f *space_id , int_f *rank, hsize_t_f * current_size, hsize_t_f *maximum_size); + +extern int_f nh5sis_simple_c ( hid_t_f *space_id , int_f *flag ); + +extern int_f nh5sextent_class_c ( hid_t_f *space_id , int_f *classtype); + +extern int_f nh5sget_simple_extent_dims_c ( hid_t_f *space_id , hsize_t_f *dims, hsize_t_f *maxdims); + +extern int_f nh5sextent_copy_c ( hid_t_f *dest_space_id , hid_t_f *source_space_id); + +extern int_f nh5sset_extent_none_c ( hid_t_f *space_id ); + +extern int_f nh5sselect_hyperslab_c ( hid_t_f *space_id , int_f *op, hssize_t_f *start, hsize_t_f *count, hsize_t_f *stride, hsize_t_f *block); + +extern int_f nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hssize_t_f *coord); + + +/* + * Functions from H5Df.c + */ + +#ifndef H5Df90_FNAMES +# define H5Df90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5dcreate_c FNAME(H5DCREATE_C) +# define nh5dclose_c FNAME(H5DCLOSE_C) +# define nh5dopen_c FNAME(H5DOPEN_C) +# define nh5dwrite_c FNAME(H5DWRITE_C) +# define nh5dwritec_c FNAME(H5DWRITEC_C) +# define nh5dread_c FNAME(H5DREAD_C) +# define nh5dreadc_c FNAME(H5DREADC_C) +# define nh5dget_space_c FNAME(H5DGET_SPACE_C) +# define nh5dget_type_c FNAME(H5DGET_TYPE_C) +# define nh5dget_create_plist_c FNAME(H5DGET_CREATE_PLIST_C) +# define nh5dextend_c FNAME(H5DEXTEND_C) +#else /* !DF_CAPFNAMES */ +# define nh5dcreate_c FNAME(h5dcreate_c) +# define nh5dclose_c FNAME(h5dclose_c) +# define nh5dopen_c FNAME(h5dopen_c) +# define nh5dwrite_c FNAME(h5dwrite_c) +# define nh5dwritec_c FNAME(h5dwritec_c) +# define nh5dread_c FNAME(h5dread_c) +# define nh5dreadc_c FNAME(h5dreadc_c) +# define nh5dget_space_c FNAME(h5dget_space_c) +# define nh5dget_type_c FNAME(h5dget_type_c) +# define nh5dget_create_plist_c FNAME(h5dget_create_plist_c) +# define nh5dextend_c FNAME(h5dextend_c) +#endif /* DF_CAPFNAMES */ +#endif + +extern int_f nh5dcreate_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *dset_id); + +extern int_f nh5dopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id); + +extern int_f nh5dclose_c ( hid_t_f *dset_id ); + +extern int_f nh5dwrite_c +(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf); + + +extern int_f nh5dwritec_c +(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, _fcd buf); + +extern int_f nh5dread_c +(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, void *buf); + + +extern int_f nh5dreadc_c +(hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *mem_space_id, hid_t_f *file_space_id, hid_t_f *xfer_prp, _fcd buf); + +extern int_f nh5dget_space_c ( hid_t_f *dset_id , hid_t_f *space_id); + +extern int_f nh5dget_type_c ( hid_t_f *dset_id , hid_t_f *type_id); + +extern int_f nh5dget_create_plist_c ( hid_t_f *dset_id , hid_t_f *plist_id); + +extern int_f nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims); +/* + * Functions from H5Gf.c + */ + +#ifndef H5Gf90_FNAMES +# define H5Gf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5gcreate_c FNAME(H5GCREATE_C) +# define nh5gclose_c FNAME(H5GCLOSE_C) +# define nh5gopen_c FNAME(H5GOPEN_C) +# define nh5gget_obj_info_idx_c FNAME(H5GGET_OBJ_INFO_IDX_C) +# define nh5gn_members_c FNAME(H5GN_MEMBERS_C) +# define nh5glink_c FNAME(H5GLINK_C) +# define nh5gunlink_c FNAME(H5GUNLINK_C) +# define nh5gmove_c FNAME(H5GMOVE_C) +# define nh5gget_linkval_c FNAME(H5GGET_LINKVAL_C) +# define nh5gset_comment_c FNAME(H5GSET_COMMENT_C) +# define nh5gget_comment_c FNAME(H5GGET_COMMENT_C) +#else /* !DF_CAPFNAMES */ +# define nh5gcreate_c FNAME(h5gcreate_c) +# define nh5gclose_c FNAME(h5gclose_c) +# define nh5gopen_c FNAME(h5gopen_c) +# define nh5gget_obj_info_idx_c FNAME(h5gget_obj_info_idx_c) +# define nh5gn_members_c FNAME(h5gn_members_c) +# define nh5glink_c FNAME(h5glink_c) +# define nh5gunlink_c FNAME(h5gunlink_c) +# define nh5gmove_c FNAME(h5gmove_c) +# define nh5gget_linkval_c FNAME(h5gget_linkval_c) +# define nh5gset_comment_c FNAME(h5gset_comment_c) +# define nh5gget_comment_c FNAME(h5gget_comment_c) +#endif /* DF_CAPFNAMES */ +#endif + +extern int_f nh5gcreate_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, hid_t_f *grp_id); + +extern int_f nh5gopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id); + +extern int_f nh5gclose_c ( hid_t_f *grp_id ); + +extern int_f nh5gget_obj_info_idx_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *idx, _fcd obj_name, int_f *obj_namelen, int_f *obj_type); + +extern int_f nh5gn_members_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *nmembers); + +extern int_f nh5glink_c +(hid_t_f *loc_id, int_f *link_type, _fcd current_name, int_f *current_namelen, _fcd new_name, int_f *new_namelen); + +extern int_f nh5gunlink_c +(hid_t_f *loc_id, _fcd name, int_f *namelen); + +extern int_f nh5gmove_c +(hid_t_f *loc_id, _fcd src_name, int_f *src_namelen, _fcd dst_name, int_f *dst_namelen); + +extern int_f nh5gget_linkval_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size, _fcd value ); + +extern int_f nh5gset_comment_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, _fcd comment, int_f *commentlen); + +extern int_f nh5gget_comment_c +(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *bufsize, _fcd comment); + + +/* + * Functions from H5Af.c + */ + +#ifndef H5Af90_FNAMES +# define H5Af90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5acreate_c FNAME(H5ACREATE_C) +# define nh5aclose_c FNAME(H5ACLOSE_C) +# define nh5aopen_name_c FNAME(H5AOPEN_NAME_C) +# define nh5awrite_c FNAME(H5AWRITE_C) +# define nh5awritec_c FNAME(H5AWRITEC_C) +# define nh5aread_c FNAME(H5AREAD_C) +# define nh5areadc_c FNAME(H5AREADC_C) +# define nh5aget_name_c FNAME(H5AGET_NAME_C) +# define nh5aopen_idx_c FNAME(H5AOPEN_IDX_C) +# define nh5aget_space_c FNAME(H5AGET_SPACE_C) +# define nh5aget_type_c FNAME(H5AGET_TYPE_C) +# define nh5aget_num_attrs_c FNAME(H5AGET_NUM_ATTRS_C) +# define nh5adelete_c FNAME(H5ADELETE_C) +#else /* !DF_CAPFNAMES */ +# define nh5acreate_c FNAME(h5acreate_c) +# define nh5aclose_c FNAME(h5aclose_c) +# define nh5aopen_name_c FNAME(h5aopen_name_c) +# define nh5awrite_c FNAME(h5awrite_c) +# define nh5awritec_c FNAME(h5awritec_c) +# define nh5aread_c FNAME(h5aread_c) +# define nh5areadc_c FNAME(h5areadc_c) +# define nh5aget_name_c FNAME(h5aget_name_c) +# define nh5aopen_idx_c FNAME(h5aopen_idx_c) +# define nh5aget_space_c FNAME(h5aget_space_c) +# define nh5aget_type_c FNAME(h5aget_type_c) +# define nh5aget_num_attrs_c FNAME(h5aget_num_attrs_c) +# define nh5adelete_c FNAME(h5adelete_c) +#endif /* DF_CAPFNAMES */ +#endif + + +extern int_f nh5acreate_c (hid_t_f *obj_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *attr_id); + +extern int_f +nh5aopen_name_c (hid_t_f *obj_id, _fcd name, int_f *namelen, hid_t_f *attr_id); + +extern int_f nh5awritec_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf); + +extern int_f nh5awrite_c (hid_t_f *attr_id, hid_t_f *mem_type_id, void *buf); + +extern int_f nh5areadc_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf); + +extern int_f nh5aread_c (hid_t_f *attr_id, hid_t_f *mem_type_id, void *buf); + +extern int_f nh5aclose_c ( hid_t_f *attr_id ); + +extern int_f nh5adelete_c (hid_t_f *obj_id, _fcd name, int_f *namelen); + +extern int_f nh5aopen_idx_c (hid_t_f *obj_id, int_f *idx, hid_t_f *attr_id); + +extern int_f nh5aget_space_c (hid_t_f *attr_id, hid_t_f *space_id); + +extern int_f nh5aget_type_c (hid_t_f *attr_id, hid_t_f *type_id); + +extern int_f nh5aget_num_attrs_c (hid_t_f *obj_id, int_f *attr_num); + +extern int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf); + +/* + * Functions form H5Tf.c file + */ +#ifndef H5Tf90_FNAMES +# define H5Tf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5topen_c FNAME(H5TOPEN_C) +# define nh5tcommit_c FNAME(H5TCOMMIT_C) +# define nh5tcommitted_c FNAME(H5TCOMMITTED_C) +# define nh5tclose_c FNAME(H5TCLOSE_C) +# define nh5tcopy_c FNAME(H5TCOPY_C) +# define nh5tequal_c FNAME(H5TEQUAL_C) +# define nh5tget_class_c FNAME(H5TGET_CLASS_C) +# define nh5tget_order_c FNAME(H5TGET_ORDER_C) +# define nh5tset_order_c FNAME(H5TSET_ORDER_C) +# define nh5tget_size_c FNAME(H5TGET_SIZE_C) +# define nh5tset_size_c FNAME(H5TSET_SIZE_C) +# define nh5tget_precision_c FNAME(H5TGET_PRECISION_C) +# define nh5tset_precision_c FNAME(H5TSET_PRECISION_C) +# define nh5tget_offset_c FNAME(H5TGET_OFFSET_C) +# define nh5tset_offset_c FNAME(H5TSET_OFFSET_C) +# define nh5tget_pad_c FNAME(H5TGET_PAD_C) +# define nh5tset_pad_c FNAME(H5TSET_PAD_C) +# define nh5tget_sign_c FNAME(H5TGET_SIGN_C) +# define nh5tset_sign_c FNAME(H5TSET_SIGN_C) +# define nh5tget_fields_c FNAME(H5TGET_FIELDS_C) +# define nh5tset_fields_c FNAME(H5TSET_FIELDS_C) +# define nh5tget_ebias_c FNAME(H5TGET_EBIAS_C) +# define nh5tset_ebias_c FNAME(H5TSET_EBIAS_C) +# define nh5tget_norm_c FNAME(H5TGET_NORM_C) +# define nh5tset_norm_c FNAME(H5TSET_NORM_C) +# define nh5tget_inpad_c FNAME(H5TGET_INPAD_C) +# define nh5tset_inpad_c FNAME(H5TSET_INPAD_C) +# define nh5tget_cset_c FNAME(H5TGET_CSET_C) +# define nh5tset_cset_c FNAME(H5TSET_CSET_C) +# define nh5tget_strpad_c FNAME(H5TGET_STRPAD_C) +# define nh5tset_strpad_c FNAME(H5TSET_STRPAD_C) +# define nh5tget_nmembers_c FNAME(H5TGET_NMEMBERS_C) +# define nh5tget_member_name_c FNAME(H5TGET_MEMBER_NAME_C) +# define nh5tget_member_offset_c FNAME(H5TGET_MEMBER_OFFSET_C) +# define nh5tget_member_dims_c FNAME(H5TGET_MEMBER_DIMS_C) +# define nh5tget_member_type_c FNAME(H5TGET_MEMBER_TYPE_C) +# define nh5tinsert_c FNAME(H5TINSERT_C) +# define nh5tcreate_c FNAME(H5TCREATE_C) +# define nh5tpack_c FNAME(H5TPACK_C) +# define nh5tinsert_array_c FNAME(H5TINSERT_ARRAY_C) +# define nh5tinsert_array_c2 FNAME(H5TINSERT_ARRAY_C2) +# define nh5tenum_create_c FNAME(H5TENUM_CREATE_C) +# define nh5tenum_insert_c FNAME(H5TENUM_INSERT_C) +# define nh5tenum_nameof_c FNAME(H5TENUM_NAMEOF_C) +# define nh5tenum_valueof_c FNAME(H5TENUM_VALUEOF_C) +# define nh5tget_member_value_c FNAME(H5TGET_MEMBER_VALUE_C) +# define nh5set_tag_c FNAME(H5TSET_TAG_C) +# define nh5get_tag_c FNAME(H5TGET_TAG_C) +#else +# define nh5topen_c FNAME(h5topen_c) +# define nh5tcommit_c FNAME(h5tcommit_c) +# define nh5tcommitted_c FNAME(h5tcommitted_c) +# define nh5tclose_c FNAME(h5tclose_c) +# define nh5tcopy_c FNAME(h5tcopy_c) +# define nh5tequal_c FNAME(h5tequal_c) +# define nh5tget_class_c FNAME(h5tget_class_c) +# define nh5tget_order_c FNAME(h5tget_order_c) +# define nh5tset_order_c FNAME(h5tset_order_c) +# define nh5tget_size_c FNAME(h5tget_size_c) +# define nh5tset_size_c FNAME(h5tset_size_c) +# define nh5tget_precision_c FNAME(h5tget_precision_c) +# define nh5tset_precision_c FNAME(h5tset_precision_c) +# define nh5tget_offset_c FNAME(h5tget_offset_c) +# define nh5tset_offset_c FNAME(h5tset_offset_c) +# define nh5tget_pad_c FNAME(h5tget_pad_c) +# define nh5tset_pad_c FNAME(h5tset_pad_c) +# define nh5tget_sign_c FNAME(h5tget_sign_c) +# define nh5tset_sign_c FNAME(h5tset_sign_c) +# define nh5tget_fields_c FNAME(h5tget_fields_c) +# define nh5tset_fields_c FNAME(h5tset_fields_c) +# define nh5tget_ebias_c FNAME(h5tget_ebias_c) +# define nh5tset_ebias_c FNAME(h5tset_ebias_c) +# define nh5tget_norm_c FNAME(h5tget_norm_c) +# define nh5tset_norm_c FNAME(h5tset_norm_c) +# define nh5tget_inpad_c FNAME(h5tget_inpad_c) +# define nh5tset_inpad_c FNAME(h5tset_inpad_c) +# define nh5tget_cset_c FNAME(h5tget_cset_c) +# define nh5tset_cset_c FNAME(h5tset_cset_c) +# define nh5tget_strpad_c FNAME(h5tget_strpad_c) +# define nh5tset_strpad_c FNAME(h5tset_strpad_c) +# define nh5tget_nmembers_c FNAME(h5tget_nmembers_c) +# define nh5tget_member_name_c FNAME(h5tget_member_name_c) +# define nh5tget_member_offset_c FNAME(h5tget_member_offset_c) +# define nh5tget_member_dims_c FNAME(h5tget_member_dims_c) +# define nh5tget_member_type_c FNAME(h5tget_member_type_c) +# define nh5tinsert_c FNAME(h5tinsert_c) +# define nh5tcreate_c FNAME(h5tcreate_c) +# define nh5tpack_c FNAME(h5tpack_c) +# define nh5tinsert_array_c FNAME(h5tinsert_array_c) +# define nh5tinsert_array_c2 FNAME(h5tinsert_array_c2) +# define nh5tenum_create_c FNAME(h5tenum_create_c) +# define nh5tenum_insert_c FNAME(h5tenum_insert_c) +# define nh5tenum_nameof_c FNAME(h5tenum_nameof_c) +# define nh5tenum_valueof_c FNAME(h5tenum_valueof_c) +# define nh5tget_member_value_c FNAME(h5tget_member_value_c) +# define nh5tset_tag_c FNAME(h5tset_tag_c) +# define nh5tget_tag_c FNAME(h5tget_tag_c) +#endif +#endif + +extern int_f nh5tcreate_c(int_f *class, size_t_f *size, hid_t_f *type_id); + +extern int_f nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id); + +extern int_f +nh5tcommit_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id); + +extern int_f nh5tclose_c ( hid_t_f *type_id ); + +extern int_f nh5tequal_c ( hid_t_f *type1_id , hid_t_f *type2_id, int_f *c_flag); + +extern int_f nh5tcopy_c ( hid_t_f *type_id , hid_t_f *new_type_id); + +extern int_f nh5tget_class_c ( hid_t_f *type_id , int_f *classtype); + +extern int_f nh5tget_order_c ( hid_t_f *type_id , int_f *order); + +extern int_f nh5tset_order_c ( hid_t_f *type_id , int_f *order); + +extern int_f nh5tget_size_c ( hid_t_f *type_id , size_t_f *size); + +extern int_f nh5tset_size_c ( hid_t_f *type_id , size_t_f *size); +extern int_f nh5tcommitted_c (hid_t_f *type_id); +extern int_f nh5tget_precision_c ( hid_t_f *type_id , size_t_f *precision); +extern int_f nh5tset_precision_c ( hid_t_f *type_id , size_t_f *precision); +extern int_f nh5tget_offset_c ( hid_t_f *type_id , size_t_f *offset); +extern int_f nh5tset_offset_c ( hid_t_f *type_id , size_t_f *offset); +extern int_f nh5tget_pad_c ( hid_t_f *type_id , int_f * lsbpad, int_f * msbpad); +extern int_f nh5tset_pad_c ( hid_t_f *type_id, int_f * lsbpad, int_f * msbpad ); +extern int_f nh5tget_sign_c ( hid_t_f *type_id , int_f* sign); +extern int_f nh5tset_sign_c ( hid_t_f *type_id , int_f *sign); +extern int_f nh5tget_fields_c ( hid_t_f *type_id, size_t_f *spos, size_t_f *epos, size_t_f* esize, size_t_f* mpos, size_t_f* msize); +extern int_f nh5tset_fields_c ( hid_t_f *type_id, size_t_f *spos, size_t_f *epos, size_t_f* esize, size_t_f* mpos, size_t_f* msize); +extern int_f nh5tget_ebias_c ( hid_t_f *type_id , size_t_f *ebias); + +extern int_f nh5tset_ebias_c ( hid_t_f *type_id , size_t_f *ebias); +extern int_f nh5tget_norm_c ( hid_t_f *type_id , int_f *norm); + +extern int_f nh5tset_norm_c ( hid_t_f *type_id , int_f *norm); +extern int_f nh5tget_inpad_c ( hid_t_f *type_id, int_f * padtype); +extern int_f nh5tset_inpad_c ( hid_t_f *type_id, int_f * padtype); +extern int_f nh5tget_cset_c ( hid_t_f *type_id, int_f * cset); +extern int_f nh5tset_cset_c ( hid_t_f *type_id, int_f * cset); +extern int_f nh5tget_strpad_c ( hid_t_f *type_id, int_f * strpad); +extern int_f nh5tset_strpad_c ( hid_t_f *type_id, int_f * strpad); +extern int_f nh5tget_nmembers_c ( hid_t_f *type_id , int_f * num_members); +extern int_f nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member_name, int_f *namelen); +extern int_f nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t_f * field_dims, int_f * perm ); +extern int_f nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f* offset); +extern int_f nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype); +extern int_f nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_t_f * field_id); +extern int_f nh5tpack_c(hid_t_f * type_id); + +extern int_f nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id, int_f* perm ); + +extern int_f nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id); + +extern int_f nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id); + +extern int_f nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); +extern int_f +nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen); +extern int_f +nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); +extern int_f +nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value); +extern int_f +nh5tset_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen); +extern int_f +nh5tget_tag_c(hid_t_f* type_id, _fcd tag, int_f* namelen); + + +/* + * Functions from H5Pf.c + */ + +#ifndef H5Pf90_FNAMES +# define H5Pf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5pcreate_c FNAME(H5PCREATE_C) +# define nh5pclose_c FNAME(H5PCLOSE_C) +# define nh5pcopy_c FNAME(H5PCOPY_C) +# define nh5pget_class_c FNAME(H5PGET_CLASS_C) +# define nh5pset_deflate_c FNAME(H5PSET_DEFLATE_C) +# define nh5pset_preserve_c FNAME(H5PSET_PRESERVE_C) +# define nh5pget_preserve_c FNAME(H5PGET_PRESERVE_C) +# define nh5pset_chunk_c FNAME(H5PSET_CHUNK_C) +# define nh5pget_chunk_c FNAME(H5PGET_CHUNK_C) +# define nh5pset_fill_valuec_c FNAME(H5PSET_FILL_VALUEC_C) +# define nh5pset_fill_value_c FNAME(H5PSET_FILL_VALUE_C) +# define nh5pget_fill_valuec_c FNAME(H5PGET_FILL_VALUEC_C) +# define nh5pget_fill_value_c FNAME(H5PGET_FILL_VALUE_C) +# define nh5pget_version_c FNAME(H5PGET_VERSION_C) +# define nh5pget_userblock_c FNAME(H5PGET_USERBLOCK_C) +# define nh5pset_userblock_c FNAME(H5PSET_USERBLOCK_C) +# define nh5pset_sizes_c FNAME(H5PSET_SIZES_C) +# define nh5pget_sizes_c FNAME(H5PGET_SIZES_C) +# define nh5pget_sym_k_c FNAME(H5PGET_SYM_K_C) +# define nh5pset_sym_k_c FNAME(H5PSET_SYM_K_C) +# define nh5pget_istore_k_c FNAME(H5PGET_ISTORE_K_C) +# define nh5pset_istore_k_c FNAME(H5PSET_ISTORE_K_C) +# define nh5pget_driver_c FNAME(H5PGET_DRIVER_C) +# define nh5pset_stdio_c FNAME(H5PSET_STDIO_C) +# define nh5pget_stdio_c FNAME(H5PGET_STDIO_C) +# define nh5pset_sec2_c FNAME(H5PSET_SEC2_C) +# define nh5pget_sec2_c FNAME(H5PGET_SEC2_C) +# define nh5pset_alignment_c FNAME(H5PSET_ALIGNMENT_C) +# define nh5pget_alignment_c FNAME(H5PGET_ALIGNMENT_C) +# define nh5pset_core_c FNAME(H5PSET_CORE_C) +# define nh5pget_core_c FNAME(H5PGET_CORE_C) +# define nh5pset_family_c FNAME(H5PSET_FAMILY_C) +# define nh5pget_family_c FNAME(H5PGET_FAMILY_C) +# define nh5pset_cache_c FNAME(H5PSET_CACHE_C) +# define nh5pget_cache_c FNAME(H5PGET_CACHE_C) +# define nh5pset_split_c FNAME(H5PSET_SPLIT_C) +# define nh5pget_split_c FNAME(H5PGET_SPLIT_C) +# define nh5pset_gc_refernces_c FNAME(H5PSET_GC_REFERENCES_C) +# define nh5pget_gc_refernces_c FNAME(H5PGET_GC_REFERENCES_C) +# define nh5pset_layout_c FNAME(H5PSET_LAYOUT_C) +# define nh5pget_layout_c FNAME(H5PGET_LAYOUT_C) +# define nh5pset_filter_c FNAME(H5PSET_FILTER_C) +# define nh5pget_nfilters_c FNAME(H5PGET_NFILTERS_C) +# define nh5pget_filter_c FNAME(H5PGET_FILTER_C) +# define nh5pset_external_c FNAME(H5PSET_EXTERNAL_C) +# define nh5pget_external_count_c FNAME(H5PGET_EXTERNAL_COUNT_C) +# define nh5pget_external_c FNAME(H5PGET_EXTERNAL_C) +# define nh5pset_hyper_cache_c FNAME(H5PSET_HYPER_CACHE_C) +# define nh5pget_hyper_cache_c FNAME(H5PGET_HYPER_CACHE_C) +# define nh5pget_btree_ratios_c FNAME(H5PGET_BTREE_RATIOS_C) +# define nh5pset_btree_ratios_c FNAME(H5PSET_BTREE_RATIOS_C) +# define nh5pset_mpi_c FNAME(H5PSET_MPI_C) +# define nh5pget_mpi_c FNAME(H5PGET_MPI_C) +# define nh5pset_xfer_c FNAME(H5PSET_XFER_C) +# define nh5pget_xfer_c FNAME(H5PGET_XFER_C) + +#else +# define nh5pcreate_c FNAME(h5pcreate_c) +# define nh5pclose_c FNAME(h5pclose_c) +# define nh5pcopy_c FNAME(h5pcopy_c) +# define nh5pget_class_c FNAME(h5pget_class_c) +# define nh5pset_deflate_c FNAME(h5pset_deflate_c) +# define nh5pset_preserve_c FNAME(h5pset_preserve_c) +# define nh5pget_preserve_c FNAME(h5pget_preserve_c) +# define nh5pset_chunk_c FNAME(h5pset_chunk_c) +# define nh5pget_chunk_c FNAME(h5pget_chunk_c) +# define nh5pset_fill_valuec_c FNAME(h5pset_fill_valuec_c) +# define nh5pset_fill_value_c FNAME(h5pset_fill_value_c) +# define nh5pget_fill_valuec_c FNAME(h5pget_fill_valuec_c) +# define nh5pget_fill_value_c FNAME(h5pget_fill_value_c) +# define nh5pget_version_c FNAME(h5pget_version_c) +# define nh5pget_userblock_c FNAME(h5pget_userblock_c) +# define nh5pset_userblock_c FNAME(h5pset_userblock_c) +# define nh5pset_sizes_c FNAME(h5pset_sizes_c) +# define nh5pget_sizes_c FNAME(h5pget_sizes_c) +# define nh5pget_sym_k_c FNAME(h5pget_sym_k_c) +# define nh5pset_sym_k_c FNAME(h5pset_sym_k_c) +# define nh5pget_istore_k_c FNAME(h5pget_istore_k_c) +# define nh5pset_istore_k_c FNAME(h5pset_istore_k_c) +# define nh5pget_driver_c FNAME(h5pget_driver_c) +# define nh5pset_stdio_c FNAME(h5pset_stdio_c) +# define nh5pget_stdio_c FNAME(h5pget_stdio_c) +# define nh5pset_sec2_c FNAME(h5pset_sec2_c) +# define nh5pget_sec2_c FNAME(h5pget_sec2_c) +# define nh5pset_alignment_c FNAME(h5pset_alignment_c) +# define nh5pget_alignment_c FNAME(h5pget_alignment_c) +# define nh5pset_core_c FNAME(h5pset_core_c) +# define nh5pget_core_c FNAME(h5pget_core_c) +# define nh5pset_family_c FNAME(h5pset_family_c) +# define nh5pget_family_c FNAME(h5pget_family_c) +# define nh5pset_cache_c FNAME(h5pset_cache_c) +# define nh5pget_cache_c FNAME(h5pget_cache_c) +# define nh5pset_split_c FNAME(h5pset_split_c) +# define nh5pget_split_c FNAME(h5pget_split_c) +# define nh5pset_gc_references_c FNAME(h5pset_gc_references_c) +# define nh5pget_gc_references_c FNAME(h5pget_gc_references_c) +# define nh5pset_layout_c FNAME(h5pset_layout_c) +# define nh5pget_layout_c FNAME(h5pget_layout_c) +# define nh5pset_filter_c FNAME(h5pset_filter_c) +# define nh5pget_nfilters_c FNAME(h5pget_nfilters_c) +# define nh5pget_filter_c FNAME(h5pget_filter_c) +# define nh5pset_external_c FNAME(h5pset_external_c) +# define nh5pget_external_count_c FNAME(h5pget_external_count_c) +# define nh5pget_external_c FNAME(h5pget_external_c) +# define nh5pset_hyper_cache_c FNAME(h5pset_hyper_cache_c) +# define nh5pget_hyper_cache_c FNAME(h5pget_hyper_cache_c) +# define nh5pget_btree_ratios_c FNAME(h5pget_btree_ratios_c) +# define nh5pset_btree_ratios_c FNAME(h5pset_btree_ratios_c) +# define nh5pset_mpi_c FNAME(h5pset_mpi_c) +# define nh5pget_mpi_c FNAME(h5pget_mpi_c) +# define nh5pset_xfer_c FNAME(h5pset_xfer_c) +# define nh5pget_xfer_c FNAME(h5pget_xfer_c) + +#endif +#endif + +extern int_f nh5pcreate_c ( int_f *classtype, hid_t_f *prp_id ); + +extern int_f nh5pclose_c ( hid_t_f *prp_id ); + +extern int_f nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id); + +extern int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype); + +extern int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level); + +extern int_f nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims ); + +extern int_f nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims ); + +extern int_f +nh5pset_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue); + +extern int_f +nh5pset_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); + +extern int_f +nh5pget_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue); + +extern int_f +nh5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); + +extern int_f +nh5pset_preserve_c ( hid_t_f *prp_id , int_f *flag); + +extern int_f +nh5pget_preserve_c ( hid_t_f *prp_id , int_f *flag); +extern int_f +nh5pget_version_c (hid_t_f *prp_id, int_f * boot,int_f * freelist, int_f * stab, int_f *shhdr); +extern int_f +nh5pset_userblock_c (hid_t_f *prp_id, hsize_t_f * size); +extern int_f +nh5pget_userblock_c (hid_t_f *prp_id, hsize_t_f * size); +extern int_f +nh5pget_sizes_c (hid_t_f *prp_id, size_t_f * sizeof_addr, size_t_f * sizeof_size); +extern int_f +nh5pset_sizes_c (hid_t_f *prp_id, size_t_f * sizeof_addr, size_t_f * sizeof_size); +extern int_f +nh5pset_sym_k_c (hid_t_f *prp_id, int_f* ik, int_f* lk); +extern int_f +nh5pget_sym_k_c (hid_t_f *prp_id, int_f* ik, int_f* lk); +extern int_f +nh5pset_istore_k_c (hid_t_f *prp_id, int_f* ik); +extern int_f +nh5pget_istore_k_c (hid_t_f *prp_id, int_f* ik); +extern int_f +nh5pget_driver_c (hid_t_f *prp_id, int_f*driver); +extern int_f +nh5pset_stdio_c (hid_t_f *prp_id); +extern int_f +nh5pget_stdio_c (hid_t_f *prp_id, int_f* io); +extern int_f +nh5pset_sec2_c (hid_t_f *prp_id); +extern int_f +nh5pget_sec2_c (hid_t_f *prp_id, int_f* sec2); +extern int_f +nh5pset_alignment_c(hid_t_f *prp_id, hsize_t_f* threshold, hsize_t_f* alignment); +extern int_f +nh5pget_alignment_c(hid_t_f *prp_id, hsize_t_f* threshold, hsize_t_f* alignment); +extern int_f +nh5pget_core_c (hid_t_f *prp_id, size_t_f* increment); +extern int_f +nh5pset_core_c (hid_t_f *prp_id, size_t_f* increment); +extern int_f +nh5pset_family_c (hid_t_f *prp_id, hsize_t_f* memb_size, hid_t_f* memb_plist ); +extern int_f +nh5pget_family_c (hid_t_f *prp_id, hsize_t_f* memb_size, hid_t_f* memb_plist ); +extern int_f +nh5pset_cache_c(hid_t_f *prp_id, int_f* mdc_nelmts, int_f* rdcc_nelmts, size_t_f* rdcc_nbytes, real_f* rdcc_w0); +extern int_f +nh5pget_cache_c(hid_t_f *prp_id, int_f* mdc_nelmts, int_f* rdcc_nelmts, size_t_f* rdcc_nbytes, real_f* rdcc_w0); +extern int_f +nh5pget_split_c(hid_t_f *prp_id, size_t_f* meta_ext_size , _fcd meta_ext, hid_t_f* meta_plist, size_t_f* raw_ext_size, _fcd raw_ext, hid_t_f * raw_plist); +extern int_f +nh5pset_split_c(hid_t_f *prp_id, int_f* meta_len, _fcd meta_ext, hid_t_f* meta_plist, int_f* raw_len, _fcd raw_ext, hid_t_f * raw_plist); +extern int_f +nh5pset_gc_references_c(hid_t_f *prp_id, int_f* gc_references); +extern int_f +nh5pget_gc_references_c(hid_t_f *prp_id, int_f* gc_references); +extern int_f +nh5pset_layout_c (hid_t_f *prp_id, int_f* layout); +extern int_f +nh5pget_layout_c (hid_t_f *prp_id, int_f* layout); +extern int_f +nh5pset_filter_c (hid_t_f *prp_id, int_f* filter, int_f* flags, size_t_f* cd_nelmts, int_f* cd_values ); +extern int_f +nh5pget_nfilters_c (hid_t_f *prp_id, int_f* nfilters); +extern int_f +nh5pget_filter_c(hid_t_f *prp_id, int_f* filter_number, int_f* flags, size_t_f* cd_nelmts, int_f* cd_values, size_t_f *namelen, _fcd name, int_f* filter_id); +extern int_f +nh5pset_external_c (hid_t_f *prp_id, _fcd name, int_f* namelen, int_f* offset, hsize_t_f*bytes); +extern int_f +nh5pget_external_count_c (hid_t_f *prp_id, int_f* count); +extern int_f +nh5pget_external_c(hid_t_f *prp_id,int*idx, size_t_f* name_size, _fcd name, int_f* offset, hsize_t_f*bytes); +extern int_f +nh5pset_hyper_cache_c(hid_t_f *prp_id, int_f* cache, int_f* limit); +extern int_f +nh5pget_hyper_cache_c(hid_t_f *prp_id, int_f* cache, int_f* limit); +extern int_f +nh5pget_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* right); +extern int_f +nh5pset_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* right); +extern int_f +nh5pget_mpi_c(hid_t_f *prp_id, int_f* comm, int_f* info); +extern int_f +nh5pset_mpi_c(hid_t_f *prp_id, int_f* comm, int_f* info); +extern int_f +nh5pget_xfer_c(hid_t_f *prp_id, int_f* data_xfer_mode); +extern int_f +nh5pset_xfer_c(hid_t_f *prp_id, int_f* data_xfer_mode); + +/* + * Functions frome H5Rf.c + */ +#ifndef H5Rf90_FNAMES +# define H5Rf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5rcreate_object_c FNAME(H5RCREATE_OBJECT_C) +# define nh5rcreate_region_c FNAME(H5RCREATE_REGION_C) +# define nh5rdereference_region_c FNAME(H5RDEREFERENCE_REGION_C) +# define nh5rdereference_object_c FNAME(H5RDEREFERENCE_OBJECT_C) +# define nh5rget_region_region_c FNAME(H5RGET_REGION_REGION_C) +# define nh5rget_object_type_obj_c FNAME(H5RGET_OBJECT_TYPE_OBJ_C) +#else /* !DF_CAPFNAMES */ +# define nh5rcreate_object_c FNAME(h5rcreate_object_c) +# define nh5rcreate_region_c FNAME(h5rcreate_region_c) +# define nh5rdereference_region_c FNAME(h5rdereference_region_c) +# define nh5rdereference_object_c FNAME(h5rdereference_object_c) +# define nh5rget_region_region_c FNAME(h5rget_region_region_c) +# define nh5rget_object_type_obj_c FNAME(h5rget_object_type_obj_c) +#endif /* DF_CAPFNAMES */ +#endif /* H5Rf90_FNAMES */ + +extern int_f +nh5rcreate_object_c (_fcd ref, hid_t_f *loc_id, _fcd name, int_f *namelen); + + +extern int_f +nh5rcreate_region_c (_fcd ref, hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *space_id); + +extern int_f +nh5rdereference_region_c (hid_t_f *dset_id, _fcd ref, hid_t_f *obj_id); + +extern int_f +nh5rdereference_object_c (hid_t_f *dset_id, _fcd ref, hid_t_f *obj_id); + +extern int_f +nh5rget_region_region_c (hid_t_f *dset_id, _fcd ref, hid_t_f *space_id); + +extern int_f +nh5rget_object_type_obj_c (hid_t_f *dset_id, _fcd ref, int_f *obj_type); + +/* + * Functions from H5If.c + */ +#ifndef H5If90_FNAMES +# define H5If90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5iget_type_c FNAME(H5IGET_TYPE_C) +#else +# define nh5iget_type_c FNAME(h5iget_type_c) +#endif +#endif + +extern int_f nh5iget_type_c(hid_t_f *obj_id, int_f *type); + + +#ifndef H5Ef90_FNAMES +# define H5Ef90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5eclear_c FNAME(H5ECLEAR_C) +# define nh5eprint_c1 FNAME(H5EPRINT_C1) +# define nh5eprint_c2 FNAME(H5EPRINT_C2) +# define nh5eget_major_c FNAME(H5EGET_MAJOR_C) +# define nh5eget_minor_c FNAME(H5EGET_MINOR_C) +# define nh5eset_auto_c FNAME(H5ESET_AUTO_C) +#else +# define nh5eclear_c FNAME(h5eclear_c) +# define nh5eprint_c1 FNAME(h5eprint_c1) +# define nh5eprint_c2 FNAME(h5eprint_c2) +# define nh5eget_major_c FNAME(h5eget_major_c) +# define nh5eget_minor_c FNAME(h5eget_minor_c) +# define nh5eset_auto_c FNAME(h5eset_auto_c) +#endif +#endif + +extern int_f nh5eclear_c(); +extern int_f nh5eprint_c1(_fcd name, int_f* namelen); +extern int_f nh5eprint_c2(); +extern int_f nh5eget_major_c(int_f* error_no, _fcd name); +extern int_f nh5eget_minor_c(int_f* error_no, _fcd name); +extern int_f nh5eset_auto_c(int_f* printflag); + +/* + * Functions from H5f90misc.c + */ +#ifndef H5MISCf90_FNAMES +# define H5MISCf90_FNAMES +#ifdef DF_CAPFNAMES +# define nh5init_types_c FNAME(H5INIT_TYPES_C) +# define nh5close_types_c FNAME(H5CLOSE_TYPES_C) +#else +# define nh5init_types_c FNAME(h5init_types_c) +# define nh5close_types_c FNAME(h5close_types_c) +#endif +#endif + +extern int_f nh5init_types_c(hid_t_f *types, hid_t_f * floatingtypes, hid_t_f * integertypes); +extern int_f nh5close_types_c(hid_t_f *types, int_f *lentypes, hid_t_f * floatingtypes, int_f * floatinglen, hid_t_f * integertypes, int_f * integerlen); + +#endif /* _H5f90proto_H */ diff --git a/fortran/src/H5fortran_flags.f90 b/fortran/src/H5fortran_flags.f90 new file mode 100644 index 0000000..d3bb5c0 --- /dev/null +++ b/fortran/src/H5fortran_flags.f90 @@ -0,0 +1,141 @@ + MODULE H5FORTRAN_FLAGS + +!H5F file interface related flags + INTEGER, PARAMETER :: H5F_ACC_RDWR_F = 1 , & + H5F_ACC_RDONLY_F = 2, & + H5F_ACC_TRUNC_F = 3, & + H5F_ACC_EXCL_F = 4, & + H5F_ACC_DEBUG_F = 5, & + H5F_SCOPE_LOCAL_F = 0, & + H5F_SCOPE_GLOBAL_F = 1 + +!H5G group interface related flags + INTEGER, PARAMETER :: H5G_UNKNOWN_F = -1 + INTEGER, PARAMETER :: H5G_LINK_F = 0 + INTEGER, PARAMETER :: H5G_GROUP_F =1 + INTEGER, PARAMETER :: H5G_DATASET_F =2 + INTEGER, PARAMETER :: H5G_TYPE_F =3 + +!H5P Property interface related flags + + INTEGER, PARAMETER :: H5P_FILE_CREATE_F = 0 + INTEGER, PARAMETER :: H5P_FILE_ACCESS_F = 1 + INTEGER, PARAMETER :: H5P_DATASET_CREATE_F = 2 + INTEGER, PARAMETER :: H5P_DATASET_XFER_F = 3 + INTEGER, PARAMETER :: H5P_MOUNT_F = 4 + INTEGER, PARAMETER :: H5P_DEFAULT_F = 6 + +!H5R Reference interface related flags + INTEGER, PARAMETER :: H5R_OBJECT_F = 0 + INTEGER, PARAMETER :: H5R_DATASET_REGION_F = -2 + +!H5S Dataspace interface related flags + INTEGER, PARAMETER :: H5S_SCALAR_F = 0 + INTEGER, PARAMETER :: H5S_SIMPLE_F = 1 + INTEGER, PARAMETER :: H5S_SELECT_SET_F = 0 + INTEGER, PARAMETER :: H5S_SELECT_OR_F =1 + INTEGER, PARAMETER :: H5S_UNLIMITED_F = -1 + INTEGER, PARAMETER :: H5S_ALL_F = -2 +!USED IN PROERTY INTERFACE + INTEGER, PARAMETER :: H5D_COMPACT_F = 0 + + INTEGER, PARAMETER :: H5D_CONTIGUOUS_F = 1 + INTEGER, PARAMETER :: H5D_CHUNKED_F = 2 + INTEGER, PARAMETER :: H5D_XFER_INDEPENDENT_F = 0 + INTEGER, PARAMETER :: H5D_XFER_COLLECTIVE_F = 1 + INTEGER, PARAMETER :: H5D_XFER_DFLT_F = 2 + +!H5T Data type interface related flags + INTEGER, PARAMETER :: H5T_NO_CLASS_F = -1 + INTEGER, PARAMETER :: H5T_INTEGER_F = 0 + INTEGER, PARAMETER :: H5T_FLOAT_F = 1 + INTEGER, PARAMETER :: H5T_TIME_F = 2 + INTEGER, PARAMETER :: H5T_STRING_F = 3 + INTEGER, PARAMETER :: H5T_BITFIELD_F = 4 + INTEGER, PARAMETER :: H5T_OPAQUE_F = 5 + INTEGER, PARAMETER :: H5T_COMPOUND_F = 6 + INTEGER, PARAMETER :: H5T_REFERENCE_F = 7 + INTEGER, PARAMETER :: H5T_ENUM_F = 8 + INTEGER, PARAMETER :: H5T_ORDER_LE_F = 0 + INTEGER, PARAMETER :: H5T_ORDER_BE_F = 1 + INTEGER, PARAMETER :: H5T_ORDER_VAX_F = 2 + + INTEGER, PARAMETER :: H5T_PAD_ZERO_F = 0 + INTEGER, PARAMETER :: H5T_PAD_ONE_F = 1 + INTEGER, PARAMETER :: H5T_PAD_BACKGROUND_F = 2 + INTEGER, PARAMETER :: H5T_PAD_ERROR_F = -1 + INTEGER, PARAMETER :: H5T_PAD_NPAD_F = 3 + + !Unsigned integer type + INTEGER, PARAMETER :: H5T_SGN_NONE_F = 0 + !Two's complement signed integer type + INTEGER, PARAMETER :: H5T_SGN_2_F = 1 + + INTEGER, PARAMETER :: H5T_SGN_ERROR_F = -1 + !MSB of mantissa is not stored, always 1 + INTEGER, PARAMETER :: H5T_NORM_IMPLIED_F = 0 + !MSB of mantissa is always 1 + INTEGER, PARAMETER :: H5T_NORM_MSBSET_F = 1 + !Mantissa is not normalized + INTEGER, PARAMETER :: H5T_NORM_NONE_F = 2 + !Character set is US ASCII + INTEGER, PARAMETER :: H5T_CSET_ASCII_F = 0 + !Pad with zeros (as C does) + INTEGER, PARAMETER :: H5T_STR_NULL_F = 0 + !Pad with spaces (as FORTRAN does) + INTEGER, PARAMETER :: H5T_STR_SPACE_F = 1 + +!H5P interface related fortran flags: + !identifier of the low-level file driver. + INTEGER, PARAMETER :: H5F_LOW_STDIO_F = 0 + INTEGER, PARAMETER :: H5F_LOW_SEC2_F = 1 + INTEGER, PARAMETER :: H5F_LOW_MPIO_F = 2 + INTEGER, PARAMETER :: H5F_LOW_CORE_F = 3 + INTEGER, PARAMETER :: H5F_LOW_SPLIT_F = 4 + INTEGER, PARAMETER :: H5F_LOW_FAMILY_F = 5 + +!H5I interface related fortran flags: + INTEGER, PARAMETER :: H5I_FILE_F = 1 + INTEGER, PARAMETER :: H5I_GROUP_F = 2 + INTEGER, PARAMETER :: H5I_DATATYPE_F = 3 + INTEGER, PARAMETER :: H5I_DATASPACE_F = 4 + INTEGER, PARAMETER :: H5I_DATASET_F = 5 + INTEGER, PARAMETER :: H5I_ATTR_F = 6 + INTEGER, PARAMETER :: H5I_BADID_F = -1 + +!H5E interface related fortran flags: + !Turn on automatic printing of errors + INTEGER, PARAMETER :: PRINTON = 1 + + !Turn off automatic printing of errors + INTEGER, PARAMETER :: PRINTOFF = 0 + + !Error flags same as H5E_major_t + + INTEGER, PARAMETER :: H5E_NONE_MAJOR_F = 0 !special zero, no error + INTEGER, PARAMETER :: H5E_ARGS_F = 1 !invalid arguments to routine + INTEGER, PARAMETER :: H5E_RESOURCE_F = 2 !resource unavailable + INTEGER, PARAMETER :: H5E_INTERNAL_F = 3 !Internal error (too specific to + !document in detail) + INTEGER, PARAMETER :: H5E_FILE_F = 4 !file Accessability + INTEGER, PARAMETER :: H5E_IO_F = 5 !Low-level I/O + INTEGER, PARAMETER :: H5E_FUNC_F = 6 !function Entry/Exit + INTEGER, PARAMETER :: H5E_ATOM_F = 7 !object Atom + INTEGER, PARAMETER :: H5E_CACHE_F = 8 !object Cache + INTEGER, PARAMETER :: H5E_BTREE_F = 9 !B-Tree Node + INTEGER, PARAMETER :: H5E_SYM_F = 10 !symbol Table + INTEGER, PARAMETER :: H5E_HEAP_F = 11 !Heap + INTEGER, PARAMETER :: H5E_OHDR_F = 12 !object Header + INTEGER, PARAMETER :: H5E_DATATYPE_F = 13 !Datatype + INTEGER, PARAMETER :: H5E_DATASPACE_F = 14 ! Dataspace + INTEGER, PARAMETER :: H5E_DATASET_F = 15 !Dataset + INTEGER, PARAMETER :: H5E_STORAGE_F = 16 !data storage + INTEGER, PARAMETER :: H5E_PLIST_F = 17 !Property lists + INTEGER, PARAMETER :: H5E_ATTR_F = 18 !Attribute + INTEGER, PARAMETER :: H5E_PLINE_F = 19 !Data filters + INTEGER, PARAMETER :: H5E_EFL_F = 20 !External file list + INTEGER, PARAMETER :: H5E_RAGGED_F = 21 !Ragged arrays + INTEGER, PARAMETER :: H5E_REFERENCE_F = 22 !References + + + END MODULE H5FORTRAN_FLAGS diff --git a/fortran/src/H5fortran_types.f90.in b/fortran/src/H5fortran_types.f90.in new file mode 100644 index 0000000..9010d7f --- /dev/null +++ b/fortran/src/H5fortran_types.f90.in @@ -0,0 +1,29 @@ +! +! This file contains HDF5 Fortran90 type definitions +! + MODULE H5FORTRAN_TYPES + ! + ! HDF5 integers + ! + ! Each of the arguments of SELECTED_INT_KIND function should be + ! determined by configure. + ! R_LARGE is the number of digits for the biggest integer supported. + ! R_INTEGER is the number of digits in INTEGER + ! For example: + ! On 64 bit machine ( DEC ALPHA) R_LARGE = 18 and R_INTEGER = 9 + ! On 32 bit machines ( Sparc Solaris ) R_LARGE = 9 and R_INTEGER = 9 + ! + INTEGER, PARAMETER :: R_LARGE = @R_LARGE@ + INTEGER, PARAMETER :: R_INTEGER = @R_INTEGER@ + INTEGER, PARAMETER :: HSIZE_T = @HSIZE_T@ + INTEGER, PARAMETER :: HSSIZE_T = @HSSIZE_T@ + INTEGER, PARAMETER :: HID_T = @HID_T@ + INTEGER, PARAMETER :: SIZE_T = @SIZE_T@ + + ! + ! Some HDF5 FORTARN90 default values ( here for now 8/5/99 EIP ) + ! + + INTEGER(SIZE_T), PARAMETER :: OBJECT_NAMELEN_DEFAULT_F = @OBJECT_NAMELEN_DEFAULT_F@ + + END MODULE H5FORTRAN_TYPES diff --git a/fortran/src/HDF5.f90 b/fortran/src/HDF5.f90 new file mode 100644 index 0000000..264eb13 --- /dev/null +++ b/fortran/src/HDF5.f90 @@ -0,0 +1,14 @@ + + MODULE HDF5 + USE H5GLOBAL + USE H5F + USE H5G + USE H5E + USE H5I + USE H5S + USE H5D + USE H5A + USE H5T + USE H5P + USE H5R + END MODULE HDF5 diff --git a/fortran/src/HDF5_parallel.f90 b/fortran/src/HDF5_parallel.f90 new file mode 100644 index 0000000..d44ba17 --- /dev/null +++ b/fortran/src/HDF5_parallel.f90 @@ -0,0 +1,15 @@ + + MODULE HDF5 + USE H5GLOBAL + USE H5F + USE H5E + USE H5G + USE H5I + USE H5S + USE H5D + USE H5A + USE H5T + USE H5P + USE H5P_parallel + USE H5R + END MODULE HDF5 diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in new file mode 100644 index 0000000..c3f2ff1 --- /dev/null +++ b/fortran/src/Makefile.in @@ -0,0 +1,38 @@ +## +## HDF5 Forgran Library Makefile(.in) +## +## Copyright (C) 2000 National Center for Supercomputing Applications. +## All rights reserved. +## +top_srcdir=@top_srcdir@ +top_builddir=.. +srcdir=@srcdir@ +@COMMENCE@ + +hdf5_dir=$(top_srcdir)/../src + +TRACE=perl $(top_srcdir)/bin/trace + +## Add `-I.' to the C preprocessor flags. +CPPFLAGS=-I. -I$(hdf5_dir) @CPPFLAGS@ + +## This is our main target +LIB=libhdf5_fortran.la +CLEAN=H5fortran_types.f90 + +## Source and object files for the library +CPARALLEL=${PARALLEL:yes="H5Pf_parallel.c"} +CLIB_SRC=H5f90kit.c H5f90misc.c H5Git.c H5Rf.c H5Ff.c H5Sf.c H5Df.c H5Gf.c \ + H5Af.c H5Tf.c H5Pf.c H5If.c H5Ef.c ${CPARALLEL:no=} + +FPARALLEL=${PARALLEL:yes="H5Pff_parallel.f90 HDF5_parallel.f90"} +FLIB_SRC=H5fortran_types.f90 H5fortran_flags.f90 H5f90global.f90 H5f90miscf.f90 \ + H5Rff.f90 H5Fff.f90 H5Sff.f90 H5Dff.f90 H5Gff.f90 H5Aff.f90 H5Tff.f90 \ + H5Pff.f90 H5Iff.f90 H5Eff.f90 HDF5.f90 ${FPARALLEL:no=} + +LIB_SRC=$(CLIB_SRC) $(FLIB_SRC) +LIB_OBJ=$(CLIB_SRC:.c=.lo) $(FLIB_SRC:.f90=.lo) + +ARFLAGS=rc + +@CONCLUDE@ diff --git a/fortran/src/README b/fortran/src/README new file mode 100644 index 0000000..6dcc0e0 --- /dev/null +++ b/fortran/src/README @@ -0,0 +1,240 @@ + + README for the FORTRAN90 Prototype APIs to HDF5 + + +This distribution contains the HDF5 FORTRAN90 APIs source code (prototype) +based on the HDF5 1.2.2 release (ftp://ftp.ncsa.uiuc.edu/HDF/HDF5/current), +tests and examples. + +This prototype supports a selected subset of the HDF5 Library functionality. +A complete list of the Fortran subroutines can be found in the HDF5 +Reference Manual provided with this release. +Check the online documentation at http://hdf.ncsa.uiuc.edu/HDF5/doc (select +the "HDF5 Fortran90 Docs" link at the bottom of the left-hand column) or +H5_F90.R1.2.2.RefMan.tar at ftp://hdf.ncsa.uiuc.edu/HDF5/fortran . + +Changes since last release (October 1999) +========================================= +* Support for Linux +* Support for parallel features (tested on O2K platform only) +* Most of the functions from the H5R, H5P, H5T, H5E and H5I interfaces were + implemented. See Reference Manual for complete list. The new functions + include support for object and dataset region references, and for + compound datatypes. +* This prototype supports more predefined types. See list below in + the "About the Fortran APIs" section. +* This prototype supports T3E and T3E with mpt 1.3. One has to modify + H5Dff.f90, H5Aff.f90, H5Pff.f90 to comment lines with the module procedures for + double precision datatypes. See source code. + +Supported platforms +=================== +The FORTRAN90 APIs provided here are known to work with the +following platforms and compilers: + + * SunOS 5.6 with WorkshopCompilers 4.2 Fortran 90 1.2 + * SunOS 5.7 with WorkshopCompilers 5.0 Fortran 90 2.0 + * OSF1 V4.0 with Digital Fortran 90 4.1 + * IRIX64 6.5 (64 option only) with MIPSpro Compilers: Version 7.3.1m + mpt.1.4 + * Linux RedHat 6.1, Kernel 2.2.12 with PGF90 + * T3E with Cray Fortran: Version 3.4.0.0 + with mpt 1.3 + +Compilation +=========== + +1. Install HDF5 Release 1.2.2 on your system + (ftp://ftp.ncsa.uiuc.edu/HDF/HDF5/current). If you are using a + binary distribution provided by the HDF group, make sure that a GZIP + library is installed on your system. If you do not have a GZIP library, + you may copy it from the HDF FTP server. + +2. In the src directory copy H5fortran_types.f90_<system> to + H5fortran_types.f90, where <system> is one of the following: + + solaris + digunix + irix + linux + + Example: On Digital Unix systems use the following command + cp H5fortran_types.f90_digunix H5fortran_types.f90 + +3. Edit Makefile_<system >in the src/, test/ and examples/ directories + to specify the locations of the HDF5 C Library, the GZIP Library, and the + corresponding include files on your system. + +4. In the src directory, run make to create the HDF5 FORTRAN90 library + hdf5_fortran.a + make -f Makefile_<system> + + Example: On Solaris run + make -f Makefile_solaris + + The Fortran library hdf5_fortran.a will be created. + +5. In the test directory, build tests by running + make -f Makefile_<system> + This command will build fortranlib_test, fflush1 and fflush2 executables. + Run those executables to make sure that the library works on your system. + +6. In the examples directory, run + make -f Makefile_<system> + to build the following examples: + + fileexample - creates an HDF5 file + dsetexample - creates an empty dataset of integers + rwdsetexample - writes and reads to the dataset created by dsetexample + groupexample - creates a group in the file + grpsexample - creates groups using absolute and relative names + grpdsetexample - creates datasets in the groups + hyperslabexample - writes and reads a hyperslab + selectele - writes element selections + grpit - iterates through the members of the group + attrexample - creates and writes a dataset attribute + compound - creates, writes and reads one dim array of structures + mountexample - shows how to use mounting files to access a dataset + refobjexample - creates and stores references to the objects + refregexample - creates and stores references to the dataset regions + + The script run_example.sh runs the examples in the appropriate order. + + Use the HDF5 utility, h5dump, to see the content of the created HDF5 files. + +7. Install the HDF5 Reference Manual (in HTML format). The manual + can be found in the Unix tar file H5_F90.R1.2.2.RefMan.tar + on the ftp server and is served over the Web from + http://hdf.ncsa.uiuc.edu/HDF5/doc/ (select the "HDF5 Fortran90 Docs" + link at the bottom of the left-hand column). + + +8. Send bug reports and comments to hdfhelp@ncsa.uiuc.edu + +User's Guide Notes ++++++++++++++++++++ + +About the source code organization +================================== + +The Fortran APIs are organized in modules parallel to the HDF5 Interfaces. +Each module is in a separate file with the name H5*ff.f. Corresponding C +stubs are in the H5*f.c files. For example, the Fortran File APIs are in +the file H5Fff.f and the corresponding C stubs are in the file H5Ff.c. + +Each module contains Fortran definitions of the constants, interfaces to +the subroutines if needed, and the subroutines themselves. + +Users must use constant names in their programs instead of the numerical +values, as the numerical values are subject to change without notice. + +About the Fortran APIs +======================= + +* The Fortran APIs come in the form of Fortran subroutines. + +* Each Fortran subroutine name is derived from the corresponding C function + name by adding "_f" to the name. For example, the name of the C function + to create an HDF5 file is H5Fcreate; the corresponding Fortran subroutine + is h5fcreate_f. + +* A description of each Fortran subroutine and its parameters can be found + following the description of the corresponding C function in the + Reference Manual provided with this release. The manual can be found in + the Unix tar file H5_F90.R1.2.2.tar in this directory and + is served over the Web from http://hdf.ncsa.uiuc.edu/HDF5/doc/ (select + the "HDF5 Fortran90 Docs" link at the bottom of the left-hand column). + +* The parameter list for each Fortran subroutine has two more parameters + than the corresponding C function. These additional parameters hold + the return value and an error code. The order of the Fortran subroutine + parameters may differ from the order of the C function parameters. + The Fortran subroutine parameters are listed in the following order: + -- required input parameters, + -- output parameters, including return value and error code, and + -- optional input parameters. + For example, the C function to create a dataset has the following + prototype: + + hid_t H5Dcreate(hid_it loc_id, char *name, hid_t type_id, + hid_t space_id, hid_t creation_prp); + + The corresponding Fortran subroutine has the following form: + + SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, + hdferr, creation_prp) + + The first four parameters of the Fortran subroutine correspond to the + C function parameters. The fifth parameter dset_id is an output + parameter and contains a valid dataset identifier if the value of the + sixth output parameter hdferr indicates successful completion. + (Error code descriptions are provided with the subroutine descriptions + in the Reference Manual.) The seventh input parameter creation_prp + is optional, and may be omitted when the default creation property + list is used. + +* Parameters to the Fortran subroutines have one of the following + predefined datatypes (see the file H5fortran_types.f90 for KIND + definitions): + + INTEGER(HID_T) compares with hid_t type in HDF5 C APIs + INTEGER(HSIZE_T) compares with hsize_t in HDF5 C APIs + INTEGER(HSSIZE_T) compares with hssize_t in HDF5 C APIs + INTEGER(SIZE_T) compares with the C size_t type + These integer types usually correspond to 4 or 8 byte integers, + depending on the FORTRAN90 compiler and corresponding HDF5 + C library definitions. + + The H5R module defines two types: + TYPE(HOBJ_REF_T_F) compares to the hobj_ref_t in HDF5 C API + TYPE(HDSET_REG_REF_T_F) compares to hdset_reg_ref_t in HDF5 C API + These types are represented by character arrays now. + The internal representation can be changed in the future. + +* Each Fortran application must call the h5init_types subroutine to + initialize the Fortran predefined datatypes before calling the HDF5 Fortran + subroutines. The application must call the h5close_types subroutine + after all calls to the HDF5 Fortran Library. + +* The following predefined types are implemented in this prototype: + + H5T_NATIVE_INTEGER + H5T_NATIVE_REAL + H5T_NATIVE_DOUBLE + H5T_NATIVE_CHARACTER + H5T_STD_REF_OBJ + H5T_STD_REF_DSETREG + H5T_IEEE_F32BE + H5T_IEEE_F32LE + H5T_IEEE_F64BE + H5T_IEEE_F64LE + H5T_STD_I8BE + H5T_STD_I8LE + H5T_STD_I16BE + H5T_STD_I16LE + H5T_STD_I32BE + H5T_STD_I32LE + H5T_STD_I64BE + H5T_STD_I64LE + H5T_STD_U8BE + H5T_STD_U8LE + H5T_STD_U16BE + H5T_STD_U16LE + H5T_STD_U32BE + H5T_STD_U32LE + H5T_STD_U64BE + H5T_STD_U64LE + + +* When a C application reads data stored from a Fortran program, the data + will appear to be transposed due to the difference in the C - Fortran + storage order. For example, if Fortran writes a 4x6 two-dimensional dataset + to the file, a C program will read it as a 6x4 two-dimensional dataset into + memory. The HDF5 C utilities h5dump and h5ls display transposed data, if + data is written from a Fortran program. + +* Fortran indices are 1 based. + +* Compound datatype datasets can be written or read by atomic fields only. + +Not all of the APIs provided with this prototype have been fully tested. |