diff options
| author | Elena Pourmal <epourmal@hdfgroup.org> | 2008-05-03 23:39:37 (GMT) |
|---|---|---|
| committer | Elena Pourmal <epourmal@hdfgroup.org> | 2008-05-03 23:39:37 (GMT) |
| commit | dcad778b42d371c5429b913c65ec5c32f658d94e (patch) | |
| tree | 3aa9f6ad4ef79064db548aa0ff692d2d1c6bbb51 /fortran | |
| parent | 8090e1c6035e784402f8185434f291b63fe1d7c2 (diff) | |
| download | hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.zip hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.tar.gz hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.tar.bz2 | |
[svn-r14923] Maintenance: This check-in merges changes from the fortran_1_8 branch back into the trunk (up to revision 14921)
Platforms tested: kagiso with g95 and Intel compilers; more testing will be done after checking in a fresh
copy from the trunk. New code itself was tested with all Fortran compilers available at THG
Diffstat (limited to 'fortran')
47 files changed, 19610 insertions, 1976 deletions
diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c index 0be225b..5fdc27e 100644 --- a/fortran/src/H5Af.c +++ b/fortran/src/H5Af.c @@ -35,7 +35,7 @@ *---------------------------------------------------------------------------*/ int_f nh5acreate_c(hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *type_id, - hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *attr_id) + hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *aapl, hid_t_f *attr_id) { char *c_name = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ @@ -49,7 +49,7 @@ nh5acreate_c(hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *type_id, /* * Call H5Acreate2 function. */ - if((*attr_id = (hid_t_f)H5Acreate2((hid_t)*obj_id, c_name, (hid_t)*type_id, (hid_t)*space_id, (hid_t)*crt_prp, H5P_DEFAULT)) < 0) + if((*attr_id = (hid_t_f)H5Acreate2((hid_t)*obj_id, c_name, (hid_t)*type_id, (hid_t)*space_id, (hid_t)*crt_prp, (hid_t)*aapl)) < 0) HGOTO_DONE(FAIL); done: @@ -959,7 +959,7 @@ done: * Name: h5aget_name_c * Purpose: Call H5Aget_name to get attribute's name * Inputs: attr_id - attribute identifier - * bufsize -size of the buffer + * bufsize - size of the buffer * Outputs: buf - buffer to hold the name * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal @@ -969,27 +969,801 @@ done: int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *bufsize, _fcd buf) { - char *c_buf=NULL; /* Buffer to hold C string */ + size_t c_bufsize; + char *c_buf=NULL; /* Buffer to hold C string */ + int_f ret_value=0; /* Return value */ + + c_bufsize = (size_t)*bufsize+1; + /* + * Allocate buffer to hold name of an attribute + */ + if ((c_buf = HDmalloc(c_bufsize)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Aget_name function + */ + + if ((ret_value = (int_f)H5Aget_name((hid_t)*attr_id, c_bufsize, c_buf)) < 0) + HGOTO_DONE(FAIL); + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HD5packFstring(c_buf, _fcdtocp(buf), c_bufsize-1); + +done: + if(c_buf) HDfree(c_buf); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_storage_size_c + * Purpose: Call H5Aget_storage_size + * Inputs: attr_id - identifier of an attribute + * Outputs: size - attributes storage requirements + * Returns: 0 on success, -1 on failure + * Programmer: M. S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ + +int_f +nh5aget_storage_size_c ( hid_t_f *attr_id, hsize_t_f *size) +{ + int_f ret_value=0; /* Return value */ + + if ((*size = (hsize_t_f)H5Aget_storage_size((hid_t)*attr_id)) < 0) + HGOTO_DONE(FAIL); + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_create_plist_c + * Purpose: Call H5Aget_create_plist + * Inputs: attr_id - identifier of an attribute + * Outputs: creation_prop_id - Identifier for the attribute’s creation property + * Returns: 0 on success, -1 on failure + * Programmer: M. S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ + +int_f +nh5aget_create_plist_c ( hid_t_f *attr_id, hid_t_f *creation_prop_id) +{ int_f ret_value=0; /* Return value */ + if ((*creation_prop_id = (hid_t_f)H5Aget_create_plist((hid_t)*attr_id)) < 0) + HGOTO_DONE(FAIL); + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5arename_by_name_c + * Purpose: Calls H5Arename_by_name + * Inputs: loc_id - Object identifier + * obj_name - Name of object, relative to location, + * whose attribute is to be renamed + * obj_name_len - Object name length + * old_attr_name - Prior attribute name + * old_attr_name_len - Prior attribute name length + * new_attr_name - New attribute name + * new_attr_name_len - New attribute name length + * lapl_id - Link access property list identifier + * Outputs: N/A + * Returns: 0 on success, -1 on failure + * Programmer: M. S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ + +int_f +nh5arename_by_name_c( hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd old_attr_name, size_t_f *old_attr_namelen, + _fcd new_attr_name, size_t_f *new_attr_namelen, + hid_t_f *lapl_id ) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + char *c_old_attr_name = NULL; /* Buffer to hold C string */ + char *c_new_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value=0; /* Return value */ /* - * Allocate buffer to hold name of an attribute + * Convert FORTRAN name to C name */ - if ((c_buf = HDmalloc((size_t)*bufsize +1)) == NULL) - HGOTO_DONE(FAIL); + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_old_attr_name = HD5f2cstring(old_attr_name, (size_t)*old_attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_new_attr_name = HD5f2cstring(new_attr_name, (size_t)*new_attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + if(H5Arename_by_name((hid_t)*loc_id,c_obj_name,c_old_attr_name,c_new_attr_name,(hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_obj_name) + HDfree(c_obj_name); + if(c_old_attr_name) + HDfree(c_old_attr_name); + if(c_new_attr_name) + HDfree(c_new_attr_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aopen_c + * Purpose: Call H5Aopen to open an attribute + * Inputs: obj_id - Identifer for object to which attribute is attached + * attr_name - Attribute access property list + * attr_namelen - size of attr_name + * aapl_id - Link access property list + * Outputs: attr_id - dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aopen_c (hid_t_f *obj_id, _fcd attr_name, size_t_f *attr_namelen, hid_t_f *aapl_id, hid_t_f *attr_id) +{ + char *c_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ /* - * Call H5Aget_name function + * Convert FORTRAN name to C name + */ + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + /* + * Call H5Aopen function. */ - if ((ret_value = (int_f)H5Aget_name((hid_t)*attr_id, (size_t)*bufsize, c_buf)) < 0) - HGOTO_DONE(FAIL); + + if((*attr_id = (hid_t_f)H5Aopen((hid_t)*obj_id, c_attr_name, (hid_t)*aapl_id)) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_attr_name) + HDfree(c_attr_name); + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5adelete_by_name_c + * Purpose: Call h5adelete_by_name to remove an attribute from a specified location + * Inputs: loc_id - identifer for object to which attribute is attached + * obj_name - object identifier + * obj_namelen - name length + * attr_name - name of the attribute + * attr_namelen - name length + * lapl_id - link access property list + * + * Outputs: N/A + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5adelete_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, hid_t_f *lapl_id) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + char *c_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Adelete_by_name function. + */ + if(H5Adelete_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_attr_name) + HDfree(c_attr_name); + if(c_obj_name) + HDfree(c_obj_name); + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5adelete_by_idx_c + * Purpose: Call h5adelete_by_idx + * Inputs: loc_id - Location or object identifier; may be dataset or group + * obj_name - object identifier + * obj_namelen - name length + * attr_name - name of the attribute + * attr_namelen - name length + * lapl_id - link access property list + * + * Outputs: N/A + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5adelete_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *lapl_id) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + H5_index_t c_idx_type; + H5_iter_order_t c_order; + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_idx_type = (H5_index_t)*idx_type; + c_order = (H5_iter_order_t)*order; + + /* + * Call H5Adelete_by_name function. + */ + + if(H5Adelete_by_idx((hid_t)*loc_id, c_obj_name, c_idx_type, c_order, (hsize_t)*n, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + +done: + if(c_obj_name) + HDfree(c_obj_name); + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5aget_name_by_idx_c + * Purpose: Call h5aget_name_by_idx + * Inputs: + * + * loc_id - Identifer for object to which attribute is attached + * obj_name - Name of object, relative to location, + * from which attribute is to be removed *TEST* check NULL + * idx_type - Type of index; Possible values are: + * H5_INDEX_UNKNOWN - Unknown index type + * H5_INDEX_NAME - Index on names + * H5_INDEX_CRT_ORDER - Index on creation order + * H5_INDEX_N - Number of indices defined + * + * order - Order in which to iterate over index; Possible values are: + * H5_ITER_UNKNOWN - Unknown order + * H5_ITER_INC - Increasing order + * H5_ITER_DEC - Decreasing order + * H5_ITER_NATIVE - No particular order, whatever is fastest + * H5_ITER_N - Number of iteration orders + * + * n - Attribute’s position in index + * attr_id - Attribute identifier + * size - Buffer size ! *TEST* check for 0 value *CHECK* should this return the correct value + * + * lapl_id - Link access property list + * hdferr - Error code: + * Returns attribute name size, -1 if fail + * + * Outputs: name - Attribute name + * + * Returns: Size of buffer on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5aget_name_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, _fcd name, + size_t_f *size, hid_t_f *lapl_id) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + H5_index_t c_idx_type; + H5_iter_order_t c_order; + int_f ret_value = -1; /* Return value */ + ssize_t c_size; + size_t c_buf_size; + char *c_buf =NULL; + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_idx_type = (H5_index_t)*idx_type; + c_order = (H5_iter_order_t)*order; + + /* + * Allocate buffer to hold name of an attribute + */ + c_buf_size = (size_t)*size + 1; + c_buf = (char *)HDmalloc(c_buf_size); + if (c_buf == NULL) return ret_value; + + /* + * Call H5Aget_name_by_idx function. + */ + c_size = H5Aget_name_by_idx((hid_t)*loc_id, c_obj_name, c_idx_type, c_order, (hsize_t)*n, c_buf, c_buf_size,(hid_t)*lapl_id); + +/* printf( "In C routine, The attr name is %s %i \n ", c_buf, c_buf_size ); */ +/* printf( "In C routine, The c_size is %i \n ", c_size ); */ + + if (c_size < 0) goto done; /* * Convert C name to FORTRAN and place it in the given buffer */ - HD5packFstring(c_buf, _fcdtocp(buf), (size_t)*bufsize); + HD5packFstring(c_buf, _fcdtocp(name), c_buf_size); + *size = (size_t_f)c_size; + ret_value = 0; + +done: + if(c_obj_name) + HDfree(c_obj_name); + HDfree(c_buf); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aopen_by_idx_c + * Purpose: Call H5Aopen_by_idx + * Inputs: loc_id - Object identifier + * obj_name - Name of object to which attribute is attached + * obj_namelen - name length + * idx_type - Type of index; Possible values are: + * H5_INDEX_UNKNOWN - Unknown index type + * H5_INDEX_NAME - Index on names + * H5_INDEX_CRT_ORDER - Index on creation order + * H5_INDEX_N - Number of indices defined + * + * order - Order in which to iterate over index; Possible values are: + * H5_ITER_UNKNOWN - Unknown order + * H5_ITER_INC - Increasing order + * H5_ITER_DEC - Decreasing order + * H5_ITER_NATIVE - No particular order, whatever is fastest + * H5_ITER_N - Number of iteration orders + * + * n - Attribute’s position in index + * aapl_id - Attribute access property list + * lapl_id - Link access property list + * Outputs: attr_id - attribute identifer + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5aopen_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *aapl_id, hid_t_f *lapl_id, hid_t_f *attr_id ) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + H5_index_t c_idx_type; + H5_iter_order_t c_order; + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_idx_type = (H5_index_t)*idx_type; + c_order = (H5_iter_order_t)*order; + + /* + * Call H5Aopen_by_idx function. + */ + if((*attr_id = (hid_t_f)H5Aopen_by_idx((hid_t)*loc_id, c_obj_name, c_idx_type, c_order, (hsize_t)*n, (hid_t)*aapl_id, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); +done: + if(c_obj_name) + HDfree(c_obj_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_info_c + * Purpose: Call H5Aget_info + * Inputs: loc_id - Object identifier + * Outputs: + * corder_valid - Indicates whether the the creation order data is valid for this attribute + * corder - Is a positive integer containing the creation order of the attribute + * cset - Indicates the character set used for the attribute’s name + * data_size - indicates the size, in the number of characters, of the attribute + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5aget_info_c (hid_t_f *loc_id, int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ) +{ + + int_f ret_value = 0; /* Return value */ + H5A_info_t ainfo; + + + /* + * Call H5Aget_info function. + */ + if(H5Aget_info((hid_t)*loc_id,&ainfo) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *corder_valid = 0; + if(ainfo.corder_valid > 0) *corder_valid = 1; + + *corder = (int_f)ainfo.corder; + *cset = (int_f)ainfo.cset; + *data_size = (hsize_t)ainfo.data_size; + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_info_by_idx_c + * Purpose: Call H5Aget_info_by_idx + * Inputs: loc_id - Object identifier + * obj_name - Name of object to which attribute is attached + * obj_namelen - name length + * idx_type - Type of index; Possible values are: + * H5_INDEX_UNKNOWN - Unknown index type + * H5_INDEX_NAME - Index on names + * H5_INDEX_CRT_ORDER - Index on creation order + * H5_INDEX_N - Number of indices defined + * + * order - Order in which to iterate over index; Possible values are: + * H5_ITER_UNKNOWN - Unknown order + * H5_ITER_INC - Increasing order + * H5_ITER_DEC - Decreasing order + * H5_ITER_NATIVE - No particular order, whatever is fastest + * H5_ITER_N - Number of iteration orders + * + * n - Attribute’s position in index + * lapl_id - Link access property list + * Outputs: + * corder_valid - Indicates whether the the creation order data is valid for this attribute + * corder - Is a positive integer containing the creation order of the attribute + * cset - Indicates the character set used for the attribute’s name + * data_size - indicates the size, in the number of characters, of the attribute + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5aget_info_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *lapl_id, + int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + H5_index_t c_idx_type; + H5_iter_order_t c_order; + int_f ret_value = 0; /* Return value */ + H5A_info_t ainfo; + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_idx_type = (H5_index_t)*idx_type; + c_order = (H5_iter_order_t)*order; + /* + * Call H5Ainfo_by_idx function. + */ + if(H5Aget_info_by_idx((hid_t)*loc_id, c_obj_name, c_idx_type, c_order, (hsize_t)*n, + &ainfo, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *corder_valid = 0; + if(ainfo.corder_valid > 0) *corder_valid = 1; + + *corder = (int_f)ainfo.corder; + *cset = (int_f)ainfo.cset; + *data_size = (hsize_t)ainfo.data_size; + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aget_info_by_name_c + * Purpose: Call H5Aget_info_by_name + * Inputs: loc_id - Object identifier + * obj_name - Name of object to which attribute is attached + * obj_namelen - name length + * attr_name - Attribute name + * attr_namelen - attribute name length + * lapl_id - Link access property list + * Outputs: + * corder_valid - Indicates whether the the creation order data is valid for this attribute + * corder - Is a positive integer containing the creation order of the attribute + * cset - Indicates the character set used for the attribute’s name + * data_size - indicates the size, in the number of characters, of the attribute + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5aget_info_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd attr_name, size_t_f *attr_namelen, hid_t_f *lapl_id, + int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + char *c_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + H5A_info_t ainfo; + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Ainfo_by_name function. + */ + if(H5Aget_info_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, + &ainfo, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *corder_valid = 0; + if(ainfo.corder_valid > 0) *corder_valid = 1; + + *corder = (int_f)ainfo.corder; + *cset = (int_f)ainfo.cset; + *data_size = (hsize_t)ainfo.data_size; + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5acreate_by_name_c + * Purpose: Call h5acreate_by_name + + * Inputs: + * loc_id - Object identifier + * obj_name - Name of object to which attribute is attached + * obj_namelen - name length + * attr_name - Attribute name + * attr_namelen - attribute name length + * type_id - Attribute datatype identifier + * space_id - Attribute dataspace identifier + * acpl_id - Attribute creation property list identifier (Currently not used.) + * aapl_id - Attribute access property list identifier (Currently not used.) + * lapl_id - Link access property list + * + * Outputs: + * attr - an attribute identifier + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5acreate_by_name_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd attr_name, size_t_f *attr_namelen, hid_t_f *type_id, + hid_t_f *space_id, hid_t_f *acpl_id, hid_t_f *aapl_id, + hid_t_f *lapl_id, hid_t_f *attr_id ) +{ + char *c_obj_name = NULL; /* Buffer to hold C string */ + char *c_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Acreate_by_name function. + */ + if((*attr_id = (hid_t_f)H5Acreate_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, + (hid_t)*type_id, (hid_t)*space_id,(hid_t)*acpl_id,(hid_t)*aapl_id,(hid_t)*lapl_id )) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_obj_name) + HDfree(c_obj_name); + if(c_attr_name) + HDfree(c_attr_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aexists_c + * Purpose: CAll h5aexists + * Inputs: + * obj_id - Object identifier + * attr_name - Attribute name + * Outputs: + * attr_exists_c - returns a positive value, for TRUE, or 0 (zero), for FALSE. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aexists_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *attr_exists) +{ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Aexists function. + */ + if((*attr_exists = (hid_t_f)H5Aexists((hid_t)*obj_id, c_name)) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_name) + HDfree(c_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aexists_by_name_c + * Purpose: CAll H5Aexists_by_name + * Inputs: + * loc_id - Location identifier + * obj_name - Object name either relative to loc_id, absolute from the file’s root group, or '.' (a dot) + * attr_name - Attribute name + * lapl_id - Link access property list identifier + * Outputs: + * attr_exists_c - returns a positive value, for TRUE, or 0 (zero), for FALSE. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aexists_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, + hid_t_f *lapl_id, hid_t_f *attr_exists) +{ + char *c_obj_name = NULL; /* Buffer to hold object name C string */ + char *c_attr_name = NULL; /* Buffer to hold attribute name C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Aexists_by_name function. + */ + if((*attr_exists = (hid_t_f)H5Aexists_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_obj_name) + HDfree(c_obj_name); + if(c_attr_name) + HDfree(c_attr_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5aopen_by_name_c + * Purpose: Call H5Aopen_by_name + * Inputs: + * loc_id - Location identifier + * obj_name - Object name either relative to loc_id, absolute from the file’s root group, or '.' (a dot) + * attr_name - Attribute name + * aapl_id - Attribute access property list (Currently unused; should be passed in as H5P_DEFAULT.) + * lapl_id - Link access property list identifier + * Outputs: + * attr_id - attribute identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5aopen_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, + hid_t_f *aapl_id, hid_t_f *lapl_id, hid_t_f *attr_id) +{ + char *c_obj_name = NULL; /* Buffer to hold object name C string */ + char *c_attr_name = NULL; /* Buffer to hold attribute name C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_attr_name = HD5f2cstring(attr_name, (size_t)*attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Aopen function. + */ + if((*attr_id = (hid_t_f)H5Aopen_by_name((hid_t)*loc_id, c_obj_name, c_attr_name, (hid_t)*aapl_id, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_obj_name) + HDfree(c_obj_name); + if(c_attr_name) + HDfree(c_attr_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5arename_c + * Purpose: Calls H5Arename + * Inputs: loc_id - Object identifier + * old_attr_name - Prior attribute name + * old_attr_name_len - Prior attribute name length + * new_attr_name - New attribute name + * new_attr_name_len - New attribute name length + * Outputs: N/A + * Returns: 0 on success, -1 on failure + * Programmer: M. S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ + +int_f +nh5arename_c( hid_t_f *loc_id, + _fcd old_attr_name, size_t_f *old_attr_namelen, + _fcd new_attr_name, size_t_f *new_attr_namelen) +{ + char *c_old_attr_name = NULL; /* Buffer to hold C string */ + char *c_new_attr_name = NULL; /* Buffer to hold C string */ + int_f ret_value=0; /* Return value */ + /* + * Convert FORTRAN name to C name + */ + if((c_old_attr_name = HD5f2cstring(old_attr_name, (size_t)*old_attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_new_attr_name = HD5f2cstring(new_attr_name, (size_t)*new_attr_namelen)) == NULL) + HGOTO_DONE(FAIL); + + if(H5Arename((hid_t)*loc_id,c_old_attr_name,c_new_attr_name) < 0) + HGOTO_DONE(FAIL); done: - if(c_buf) HDfree(c_buf); - return ret_value; + if(c_old_attr_name) + HDfree(c_old_attr_name); + if(c_new_attr_name) + HDfree(c_new_attr_name); + return ret_value; } diff --git a/fortran/src/H5Aff.f90 b/fortran/src/H5Aff.f90 index d6f1b6f..f9e5882 100644 --- a/fortran/src/H5Aff.f90 +++ b/fortran/src/H5Aff.f90 @@ -16,96 +16,94 @@ ! ! This file contains Fortran90 interfaces for H5A functions. ! - MODULE H5A +MODULE H5A - USE H5GLOBAL + USE H5GLOBAL ! !On Windows there are no big (integer*8) integers, so overloading !for bug #670 does not work. I have to use DEC compilation directives to make !Windows DEC Visual Fortran and OSF compilers happy and do right things. ! 05/01/02 EP - -! - 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 +! + 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 Crays - 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 + 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 Crays - - 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 + 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 Crays - MODULE PROCEDURE h5aread_double_scalar - MODULE PROCEDURE h5aread_double_1 - 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 + MODULE PROCEDURE h5aread_double_scalar + MODULE PROCEDURE h5aread_double_1 + 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 Crays ! - END INTERFACE - - CONTAINS + END INTERFACE + +CONTAINS !---------------------------------------------------------------------- ! Name: h5acreate_f @@ -114,7 +112,7 @@ ! or named datatype ! ! Inputs: -! obj_id - identifier of an object (group, dataset, +! loc_id - identifier of an object (group, dataset, ! or named datatype) attribute is attached to ! name - attribute name ! type_id - attribute datatype identifier @@ -126,7 +124,8 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! creation_prp - creation property list identifier +! acpl_id - Attribute creation property list identifier +! appl_id - Attribute access property list identifier ! ! Programmer: Elena Pourmal ! August 12, 1999 @@ -136,53 +135,60 @@ ! port). February 27, 2001 ! !---------------------------------------------------------------------- - SUBROUTINE h5acreate_f(obj_id, name, type_id, space_id, attr_id, & - hdferr, creation_prp) + SUBROUTINE h5acreate_f(loc_id, name, type_id, space_id, attr_id, & + hdferr, acpl_id, aapl_id ) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5acreate_f !DEC$endif - 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(HID_T) :: creation_prp_default - INTEGER(SIZE_T) :: namelen + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_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: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: acpl_id ! Attribute creation property list identifier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id ! Attribute access property list identifier + + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + INTEGER(SIZE_T) :: namelen ! INTEGER, EXTERNAL :: h5acreate_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5acreate_c(obj_id, name, namelen, type_id, & - space_id, creation_prp_default, attr_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ACREATE_C'::h5acreate_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: obj_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(SIZE_T) :: namelen - INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER(HID_T) :: creation_prp_default - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION h5acreate_c - END INTERFACE - - 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 + INTERFACE + INTEGER FUNCTION h5acreate_c(loc_id, name, namelen, type_id, & + space_id, acpl_id_default, aapl_id_default, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ACREATE_C'::h5acreate_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T), INTENT(OUT) :: attr_id + END FUNCTION h5acreate_c + END INTERFACE + + acpl_id_default = H5P_DEFAULT_F + aapl_id_default = H5P_DEFAULT_F + namelen = LEN(NAME) + IF (PRESENT(acpl_id)) acpl_id_default = acpl_id + IF (PRESENT(aapl_id)) aapl_id_default = aapl_id + + hdferr = h5acreate_c(loc_id, name, namelen, type_id, space_id, & + acpl_id_default, aapl_id_default, attr_id) + + END SUBROUTINE h5acreate_f !---------------------------------------------------------------------- @@ -211,38 +217,38 @@ ! !---------------------------------------------------------------------- - SUBROUTINE h5aopen_name_f(obj_id, name, attr_id, hdferr) + SUBROUTINE h5aopen_name_f(obj_id, name, attr_id, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5aopen_name_f !DEC$endif - 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(SIZE_T) :: namelen + 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(SIZE_T) :: namelen ! INTEGER, EXTERNAL :: h5aopen_name_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5aopen_name_c(obj_id, name, namelen, attr_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_NAME_C'::h5aopen_name_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: obj_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(SIZE_T) :: namelen - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION h5aopen_name_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5aopen_name_c(obj_id, name, namelen, attr_id) - END SUBROUTINE h5aopen_name_f + INTERFACE + INTEGER FUNCTION h5aopen_name_c(obj_id, name, namelen, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_NAME_C'::h5aopen_name_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T), INTENT(OUT) :: attr_id + END FUNCTION h5aopen_name_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5aopen_name_c(obj_id, name, namelen, attr_id) + END SUBROUTINE h5aopen_name_f !---------------------------------------------------------------------- @@ -271,386 +277,380 @@ ! !---------------------------------------------------------------------- - SUBROUTINE h5aopen_idx_f(obj_id, index, attr_id, hdferr) + SUBROUTINE h5aopen_idx_f(obj_id, index, attr_id, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5aopen_idx_f !DEC$endif - 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 - + 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 ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5aopen_idx_c(obj_id, index, attr_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_IDX_C'::h5aopen_idx_c - !DEC$ ENDIF - INTEGER(HID_T), INTENT(IN) :: obj_id - INTEGER, INTENT(IN) :: index - INTEGER(HID_T), INTENT(OUT) :: attr_id - END FUNCTION h5aopen_idx_c - END INTERFACE - - hdferr = h5aopen_idx_c(obj_id, index, attr_id) - END SUBROUTINE h5aopen_idx_f - - - SUBROUTINE h5awrite_integer_scalar(attr_id, memtype_id, buf, dims, hdferr) + INTERFACE + INTEGER FUNCTION h5aopen_idx_c(obj_id, index, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_IDX_C'::h5aopen_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER, INTENT(IN) :: index + INTEGER(HID_T), INTENT(OUT) :: attr_id + END FUNCTION h5aopen_idx_c + END INTERFACE + + hdferr = h5aopen_idx_c(obj_id, index, attr_id) + END SUBROUTINE h5aopen_idx_f + + + SUBROUTINE h5awrite_integer_scalar(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_scalar !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN) :: buf ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_integer_s_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_s_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_S_C'::h5awrite_integer_s_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN)::buf - END FUNCTION h5awrite_integer_s_c - END INTERFACE - - hdferr = h5awrite_integer_s_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_scalar - - SUBROUTINE h5awrite_integer_1(attr_id, memtype_id, buf, dims, hdferr) + INTERFACE + INTEGER FUNCTION h5awrite_integer_s_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_S_C'::h5awrite_integer_s_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN)::buf + END FUNCTION h5awrite_integer_s_c + END INTERFACE + + hdferr = h5awrite_integer_s_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_scalar + + SUBROUTINE h5awrite_integer_1(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_1 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN) , & - DIMENSION(dims(1)) :: buf - ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code - + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN) , & + DIMENSION(dims(1)) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! INTEGER, EXTERNAL :: h5awrite_integer_1_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_1_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_1_C'::h5awrite_integer_1_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & - DIMENSION(dims(1)) :: buf - END FUNCTION h5awrite_integer_1_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5awrite_integer_1_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_1_C'::h5awrite_integer_1_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), DIMENSION(dims(1)) :: buf + END FUNCTION h5awrite_integer_1_c + END INTERFACE - hdferr = h5awrite_integer_1_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_1 + hdferr = h5awrite_integer_1_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_1 - SUBROUTINE h5awrite_integer_2(attr_id, memtype_id, buf, dims, hdferr) + + SUBROUTINE h5awrite_integer_2(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_2 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN) , & - DIMENSION(dims(1),dims(2)) :: buf - ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code - + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN) , & + DIMENSION(dims(1),dims(2)) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! INTEGER, EXTERNAL :: h5awrite_integer_2_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_2_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_2_C'::h5awrite_integer_2_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2)) :: buf - END FUNCTION h5awrite_integer_2_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5awrite_integer_2_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_2_C'::h5awrite_integer_2_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2)) :: buf + END FUNCTION h5awrite_integer_2_c + END INTERFACE - hdferr = h5awrite_integer_2_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_2 + hdferr = h5awrite_integer_2_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_2 - SUBROUTINE h5awrite_integer_3(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_integer_3(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_3 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN) , & - DIMENSION(dims(1),dims(2),dims(3)) :: buf + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2),dims(3)) :: buf ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_integer_3_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_3_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_3_C'::h5awrite_integer_3_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3)) :: buf - END FUNCTION h5awrite_integer_3_c - END INTERFACE - - hdferr = h5awrite_integer_3_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_3 - - - SUBROUTINE h5awrite_integer_4(attr_id, memtype_id, buf, dims, hdferr) + INTERFACE + INTEGER FUNCTION h5awrite_integer_3_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_3_C'::h5awrite_integer_3_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2),dims(3)) :: buf + END FUNCTION h5awrite_integer_3_c + END INTERFACE + + hdferr = h5awrite_integer_3_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_3 + + + SUBROUTINE h5awrite_integer_4(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_4 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf - ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN), & + DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_integer_4_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_4_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_4_C'::h5awrite_integer_4_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf - END FUNCTION h5awrite_integer_4_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5awrite_integer_4_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_4_C'::h5awrite_integer_4_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf + END FUNCTION h5awrite_integer_4_c + END INTERFACE - hdferr = h5awrite_integer_4_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_4 + hdferr = h5awrite_integer_4_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_4 - SUBROUTINE h5awrite_integer_5(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_integer_5(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_5 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_integer_5_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_5_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_5_C'::h5awrite_integer_5_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf - END FUNCTION h5awrite_integer_5_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5awrite_integer_5_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_5_C'::h5awrite_integer_5_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf + END FUNCTION h5awrite_integer_5_c + END INTERFACE - hdferr = h5awrite_integer_5_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_5 + hdferr = h5awrite_integer_5_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_5 - SUBROUTINE h5awrite_integer_6(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_integer_6(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_6 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf - ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code - + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN), & + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! INTEGER, EXTERNAL :: h5awrite_integer_6_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_6_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_6_C'::h5awrite_integer_6_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & + INTERFACE + INTEGER FUNCTION h5awrite_integer_6_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_6_C'::h5awrite_integer_6_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf - END FUNCTION h5awrite_integer_6_c - END INTERFACE + END FUNCTION h5awrite_integer_6_c + END INTERFACE - hdferr = h5awrite_integer_6_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_6 + hdferr = h5awrite_integer_6_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_6 - SUBROUTINE h5awrite_integer_7(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_integer_7(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_integer_7 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(IN), & - DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf - ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER, INTENT(IN), & + DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf + ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_integer_7_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_integer_7_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_7_C'::h5awrite_integer_7_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(IN), & + INTERFACE + INTEGER FUNCTION h5awrite_integer_7_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_INTEGER_7_C'::h5awrite_integer_7_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + INTEGER, INTENT(IN), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf - END FUNCTION h5awrite_integer_7_c - END INTERFACE + END FUNCTION h5awrite_integer_7_c + END INTERFACE - hdferr = h5awrite_integer_7_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_integer_7 + hdferr = h5awrite_integer_7_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_integer_7 - SUBROUTINE h5awrite_real_scalar(attr_id, memtype_id, buf, dims, hdferr) + SUBROUTINE h5awrite_real_scalar(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_real_scalar !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(IN) :: buf ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + REAL, INTENT(IN) :: buf ! Attribute data + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_real_s_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_real_s_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_REAL_S_C'::h5awrite_real_s_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(IN)::buf - END FUNCTION h5awrite_real_s_c - END INTERFACE - - hdferr = h5awrite_real_s_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_real_scalar - - SUBROUTINE h5awrite_real_1(attr_id, memtype_id, buf, dims, hdferr) + INTERFACE + INTEGER FUNCTION h5awrite_real_s_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_REAL_S_C'::h5awrite_real_s_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + REAL, INTENT(IN)::buf + END FUNCTION h5awrite_real_s_c + END INTERFACE + + hdferr = h5awrite_real_s_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_real_scalar + + SUBROUTINE h5awrite_real_1(attr_id, memtype_id, buf, dims, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5awrite_real_1 !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype - ! identifier (in memory) - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(IN), & - DIMENSION(dims(1)) :: buf + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype + ! identifier (in memory) + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + REAL, INTENT(IN), & + DIMENSION(dims(1)) :: buf ! Attribute data - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5awrite_real_1_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5awrite_real_1_c(attr_id, memtype_id, buf, dims) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_REAL_1_C'::h5awrite_real_1_c - !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(IN), & + INTERFACE + INTEGER FUNCTION h5awrite_real_1_c(attr_id, memtype_id, buf, dims) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AWRITE_REAL_1_C'::h5awrite_real_1_c + !DEC$ ENDIF + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(IN) :: memtype_id + REAL, INTENT(IN), & DIMENSION(dims(1)) :: buf - END FUNCTION h5awrite_real_1_c - END INTERFACE + END FUNCTION h5awrite_real_1_c + END INTERFACE - hdferr = h5awrite_real_1_c(attr_id, memtype_id, buf, dims) - END SUBROUTINE h5awrite_real_1 + hdferr = h5awrite_real_1_c(attr_id, memtype_id, buf, dims) + END SUBROUTINE h5awrite_real_1 SUBROUTINE h5awrite_real_2(attr_id, memtype_id, buf, dims, hdferr) @@ -1463,6 +1463,11 @@ ! dims parameter was added to make code portable; ! Aprile 4, 2001 ! +! Changed buf intent to INOUT to be consistant +! with how the C functions handles it. The pg +! compiler will return 0 if a buf value is not set. +! February, 2008 +! ! Comment: This function is overloaded to write INTEGER, ! REAL, DOUBLE PRECISION and CHARACTER buffers ! up to 7 dimensions. @@ -1478,7 +1483,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT) :: buf ! Attribute data + INTEGER, INTENT(INOUT) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_integer_s_c @@ -1490,13 +1495,12 @@ !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AREAD_INTEGER_S_C'::h5aread_integer_s_c !DEC$ ENDIF - INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes + INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT)::buf + INTEGER, INTENT(INOUT)::buf END FUNCTION h5aread_integer_s_c END INTERFACE - hdferr = h5aread_integer_s_c(attr_id, memtype_id, buf, dims) END SUBROUTINE h5aread_integer_scalar @@ -1510,8 +1514,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & - DIMENSION(dims(1)) :: buf + INTEGER, INTENT(INOUT), DIMENSION(dims(1)) :: buf INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_integer_1_c @@ -1526,8 +1529,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & - DIMENSION(dims(1)) :: buf + INTEGER, INTENT(INOUT), DIMENSION(dims(1)) :: buf END FUNCTION h5aread_integer_1_c END INTERFACE @@ -1545,8 +1547,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & - DIMENSION(dims(1),dims(2)) :: buf + INTEGER, INTENT(INOUT),DIMENSION(dims(1),dims(2)) :: buf INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_integer_2_c @@ -1561,8 +1562,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & - DIMENSION(dims(1),dims(2)) :: buf + INTEGER, INTENT(INOUT), DIMENSION(dims(1),dims(2)) :: buf END FUNCTION h5aread_integer_2_c END INTERFACE @@ -1580,8 +1580,8 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & - DIMENSION(dims(1),dims(2),dims(3)) :: buf + INTEGER, INTENT(INOUT), & + DIMENSION(dims(1),dims(2),dims(3)) :: buf INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_integer_3_c @@ -1596,7 +1596,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf END FUNCTION h5aread_integer_3_c END INTERFACE @@ -1615,7 +1615,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1632,7 +1632,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf END FUNCTION h5aread_integer_4_c END INTERFACE @@ -1651,7 +1651,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1668,7 +1668,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf END FUNCTION h5aread_integer_5_c END INTERFACE @@ -1687,7 +1687,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1704,7 +1704,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf END FUNCTION h5aread_integer_6_c END INTERFACE @@ -1723,7 +1723,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1740,7 +1740,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - INTEGER, INTENT(OUT), & + INTEGER, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf END FUNCTION h5aread_integer_7_c END INTERFACE @@ -1759,7 +1759,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT) :: buf ! Attribute data + REAL, INTENT(INOUT) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_real_s_c @@ -1774,7 +1774,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT)::buf + REAL, INTENT(INOUT)::buf END FUNCTION h5aread_real_s_c END INTERFACE @@ -1791,7 +1791,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1808,7 +1808,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1)) :: buf END FUNCTION h5aread_real_1_c END INTERFACE @@ -1827,7 +1827,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1844,7 +1844,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf END FUNCTION h5aread_real_2_c END INTERFACE @@ -1863,7 +1863,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1880,7 +1880,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf END FUNCTION h5aread_real_3_c END INTERFACE @@ -1899,7 +1899,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1916,7 +1916,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf END FUNCTION h5aread_real_4_c END INTERFACE @@ -1935,7 +1935,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1952,7 +1952,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf END FUNCTION h5aread_real_5_c END INTERFACE @@ -1971,7 +1971,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1988,7 +1988,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf END FUNCTION h5aread_real_6_c END INTERFACE @@ -2007,7 +2007,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2024,7 +2024,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - REAL, INTENT(OUT), & + REAL, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf END FUNCTION h5aread_real_7_c END INTERFACE @@ -2043,7 +2043,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT) :: buf ! Attribute data + DOUBLE PRECISION, INTENT(INOUT) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code ! INTEGER, EXTERNAL :: h5aread_double_s_c @@ -2058,7 +2058,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT)::buf + DOUBLE PRECISION, INTENT(INOUT)::buf END FUNCTION h5aread_double_s_c END INTERFACE @@ -2075,7 +2075,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2092,7 +2092,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1)) :: buf END FUNCTION h5aread_double_1_c END INTERFACE @@ -2111,7 +2111,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2128,7 +2128,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf END FUNCTION h5aread_double_2_c END INTERFACE @@ -2147,7 +2147,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2164,7 +2164,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf END FUNCTION h5aread_double_3_c END INTERFACE @@ -2183,7 +2183,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2200,7 +2200,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf END FUNCTION h5aread_double_4_c END INTERFACE @@ -2219,7 +2219,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2236,7 +2236,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf END FUNCTION h5aread_double_5_c END INTERFACE @@ -2255,7 +2255,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2272,7 +2272,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf END FUNCTION h5aread_double_6_c END INTERFACE @@ -2291,7 +2291,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2308,7 +2308,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - DOUBLE PRECISION, INTENT(OUT), & + DOUBLE PRECISION, INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf END FUNCTION h5aread_double_7_c END INTERFACE @@ -2327,7 +2327,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT) :: buf + CHARACTER(LEN=*), INTENT(INOUT) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2344,7 +2344,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*) :: buf + CHARACTER(LEN=*), INTENT(INOUT) :: buf END FUNCTION h5areadc_s_c END INTERFACE @@ -2361,7 +2361,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2379,8 +2379,8 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & - DIMENSION(dims(1)) :: buf + CHARACTER(LEN=*), INTENT(INOUT), & + DIMENSION(dims(1)) :: buf END FUNCTION h5areadc_1_c END INTERFACE @@ -2398,8 +2398,8 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & - DIMENSION(dims(1),dims(2)) :: buf + CHARACTER(LEN=*), INTENT(INOUT), & + DIMENSION(dims(1),dims(2)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2416,7 +2416,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2)) :: buf END FUNCTION h5areadc_2_c END INTERFACE @@ -2435,7 +2435,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2453,7 +2453,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3)) :: buf END FUNCTION h5areadc_3_c END INTERFACE @@ -2472,7 +2472,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2490,7 +2490,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf END FUNCTION h5areadc_4_c END INTERFACE @@ -2509,7 +2509,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2527,7 +2527,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf END FUNCTION h5areadc_5_c END INTERFACE @@ -2546,7 +2546,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2564,7 +2564,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6)) :: buf END FUNCTION h5areadc_6_c END INTERFACE @@ -2583,7 +2583,7 @@ INTEGER(HID_T), INTENT(IN) :: memtype_id ! Attribute datatype ! identifier (in memory) INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf ! Attribute data INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -2601,7 +2601,7 @@ INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims ! Array to story buf dimension sizes INTEGER(HID_T), INTENT(IN) :: attr_id INTEGER(HID_T), INTENT(IN) :: memtype_id - CHARACTER(LEN=*), INTENT(OUT), & + CHARACTER(LEN=*), INTENT(INOUT), & DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf END FUNCTION h5areadc_7_c END INTERFACE @@ -2740,37 +2740,147 @@ !---------------------------------------------------------------------- - SUBROUTINE h5aget_name_f(attr_id, size, buf, hdferr) + SUBROUTINE h5aget_name_f(attr_id, size, buf, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5aget_name_f !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER(SIZE_T), INTENT(IN) :: size ! Buffer size - CHARACTER(LEN=*), INTENT(INOUT) :: buf - ! Buffer to hold attribute name - INTEGER, INTENT(OUT) :: hdferr ! Error code: - ! name length is successful, - ! -1 if fail -! INTEGER, EXTERNAL :: h5aget_name_c + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(SIZE_T), INTENT(IN) :: size ! Buffer size + CHARACTER(LEN=*), INTENT(INOUT) :: buf + ! Buffer to hold attribute name + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! name length is successful, + ! -1 if fail + ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5aget_name_c(attr_id, size, buf) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_NAME_C'::h5aget_name_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: buf - INTEGER(HID_T), INTENT(IN) :: attr_id - INTEGER(SIZE_T), INTENT(IN) :: size - CHARACTER(LEN=*), INTENT(OUT) :: buf - END FUNCTION h5aget_name_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5aget_name_c(attr_id, size, buf) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_NAME_C'::h5aget_name_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: buf + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(SIZE_T), INTENT(IN) :: size + CHARACTER(LEN=*), INTENT(OUT) :: buf + END FUNCTION h5aget_name_c + END INTERFACE + + hdferr = h5aget_name_c(attr_id, size, buf) + END SUBROUTINE h5aget_name_f - hdferr = h5aget_name_c(attr_id, size, buf) - END SUBROUTINE h5aget_name_f +!---------------------------------------------------------------------- +! Name: h5aget_name_by_idx_f +! +! Purpose: Gets an attribute name, by attribute index position. +! +! Inputs: +! loc_id - Location of object to which attribute is attached +! obj_name - Name of object to which attribute is attached, relative to location +! idx_type - Type of index; Possible values are: +! +! H5_INDEX_UNKNOWN_F = -1 - Unknown index type +! H5_INDEX_NAME_F - Index on names +! H5_INDEX_CRT_ORDER_F - Index on creation order +! H5_INDEX_N _F - Number of indices defined +! +! order - Order in which to iterate over index; Possible values are: +! +! H5_ITER_UNKNOWN_F - Unknown order +! H5_ITER_INC_F - Increasing order +! H5_ITER_DEC_F - Decreasing order +! H5_ITER_NATIVE_F - No particular order, whatever is fastest +! H5_ITER_N_F - Number of iteration orders +! +! order - Index traversal order +! n - Attribute’s position in index +! size - Size, in bytes, of attribute name +! +! Outputs: +! name - Attribute name +! name_size_out - Size of Attribute name returned from function +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +!---------------------------------------------------------------------- + + SUBROUTINE h5aget_name_by_idx_f(loc_id, obj_name, idx_type, order, & + n, name, size, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_name_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, + ! from which attribute is to be removed *TEST* check NULL + INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + ! H5_ITER_N_F - Number of iteration orders + + INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + + CHARACTER(LEN=*), INTENT(OUT) :: name ! Attribute name + + INTEGER(SIZE_T), INTENT(INOUT) :: size ! Buffer size ! *TEST* check for 0 value *CHECK* should this return the correct value + + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! Returns attribute name size, + ! -1 if fail + INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER(HID_T) :: lapl_id_default +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_name_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, & + n, name, size, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_NAME_BY_IDX_C'::h5aget_name_by_idx_c + !DEC$ ENDIF + + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER(SIZE_T), INTENT(INOUT) :: size + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: obj_namelen + END FUNCTION h5aget_name_by_idx_c + END INTERFACE + + obj_namelen = LEN(obj_name) + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aget_name_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, & + n, name, size, lapl_id_default) + + END SUBROUTINE h5aget_name_by_idx_f !---------------------------------------------------------------------- @@ -2798,33 +2908,33 @@ ! !---------------------------------------------------------------------- - SUBROUTINE h5aget_num_attrs_f(obj_id, attr_num, hdferr) + SUBROUTINE h5aget_num_attrs_f(obj_id, attr_num, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5aget_num_attrs_f !DEC$endif - 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 + 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 ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5aget_num_attrs_c(obj_id, attr_num) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_NUM_ATTRS_C'::h5aget_num_attrs_c - !DEC$ ENDIF - INTEGER(HID_T), INTENT(IN) :: obj_id - INTEGER, INTENT(OUT) :: attr_num - END FUNCTION h5aget_num_attrs_c - END INTERFACE - - hdferr = h5aget_num_attrs_c(obj_id, attr_num) - END SUBROUTINE h5aget_num_attrs_f + INTERFACE + INTEGER FUNCTION h5aget_num_attrs_c(obj_id, attr_num) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_NUM_ATTRS_C'::h5aget_num_attrs_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER, INTENT(OUT) :: attr_num + END FUNCTION h5aget_num_attrs_c + END INTERFACE + + hdferr = h5aget_num_attrs_c(obj_id, attr_num) + END SUBROUTINE h5aget_num_attrs_f !---------------------------------------------------------------------- ! Name: h5adelete_f @@ -2852,36 +2962,36 @@ ! !---------------------------------------------------------------------- - SUBROUTINE h5adelete_f(obj_id, name, hdferr) + SUBROUTINE h5adelete_f(obj_id, name, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5adelete_f !DEC$endif - 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(SIZE_T) :: namelen + 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(SIZE_T) :: namelen ! INTEGER, EXTERNAL :: h5adelete_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5adelete_c(obj_id, name, namelen) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ADELETE_C'::h5adelete_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: obj_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER(SIZE_T) :: namelen - END FUNCTION h5adelete_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5adelete_c(obj_id, name, namelen) - END SUBROUTINE h5adelete_f + INTERFACE + INTEGER FUNCTION h5adelete_c(obj_id, name, namelen) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ADELETE_C'::h5adelete_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T) :: namelen + END FUNCTION h5adelete_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5adelete_c(obj_id, name, namelen) + END SUBROUTINE h5adelete_f !---------------------------------------------------------------------- ! Name: h5aclose_f @@ -2907,29 +3017,1177 @@ ! !---------------------------------------------------------------------- - SUBROUTINE h5aclose_f(attr_id, hdferr) + SUBROUTINE h5aclose_f(attr_id, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5aclose_f !DEC$endif - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier - INTEGER, INTENT(OUT) :: hdferr ! Error code: + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code: ! INTEGER, EXTERNAL :: h5aclose_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5aclose_c(attr_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ACLOSE_C'::h5aclose_c - !DEC$ ENDIF - INTEGER(HID_T), INTENT(IN) :: attr_id - END FUNCTION h5aclose_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5aclose_c(attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ACLOSE_C'::h5aclose_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: attr_id + END FUNCTION h5aclose_c + END INTERFACE + + hdferr = h5aclose_c(attr_id) + END SUBROUTINE h5aclose_f + +!---------------------------------------------------------------------- +! Name: h5aget_storage_size_f +! +! Purpose: Returns the amount of storage required for an attribute. +! +! Inputs: +! attr_id - attribute identifier +! Outputs: +! size - attribute storage size +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M. S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5aget_storage_size_f(attr_id, size, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_storage_size_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + INTEGER(HSIZE_T), INTENT(OUT) :: size ! Attribute storage requirement + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_storage_size_c(attr_id, size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_STORAGE_SIZE_C'::h5aget_storage_size_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HSIZE_T), INTENT(OUT) :: size + END FUNCTION h5aget_storage_size_c + END INTERFACE + + hdferr = h5aget_storage_size_c(attr_id, size) + END SUBROUTINE h5aget_storage_size_f + +!---------------------------------------------------------------------- +! Name: h5aget_create_plist_f +! +! Purpose: Gets an attribute creation property list identifier +! +! Inputs: +! attr_id - Identifier of the attribute +! Outputs: +! creation_prop_id - Identifier for the attribute’s creation property +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M. S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5aget_create_plist_f(attr_id, creation_prop_id, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_create_plist_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Identifier of the attribute + INTEGER(HID_T), INTENT(OUT) :: creation_prop_id ! Identifier for the attribute’s creation property + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_create_plist_c(attr_id, creation_prop_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_CREATE_PLIST_C'::h5aget_create_plist_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: attr_id + INTEGER(HID_T), INTENT(OUT) :: creation_prop_id + END FUNCTION h5aget_create_plist_c + END INTERFACE + + hdferr = h5aget_create_plist_c(attr_id, creation_prop_id) + END SUBROUTINE h5aget_create_plist_f + +!---------------------------------------------------------------------- +! Name: h5arename_by_name_f +! +! Purpose: Renames an attribute +! +! Inputs: +! loc_id - Location or object identifier; may be dataset or group +! obj_name - Name of object, relative to location, +! whose attribute is to be renamed +! old_attr_name - Prior attribute name +! new_attr_name - New attribute name +! lapl_id - Link access property list identifier +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5arename_by_name_f(loc_id, obj_name, old_attr_name, new_attr_name, & + hdferr, lapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5arename_by_name_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, + ! whose attribute is to be renamed + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name ! Prior attribute name + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name ! New attribute name + + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: old_attr_namelen + INTEGER(SIZE_T) :: new_attr_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5arename_by_name_c(loc_id, obj_name, obj_namelen, & + old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen, & + lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ARENAME_BY_NAME_C'::h5arename_by_name_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(SIZE_T) :: obj_namelen + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name + INTEGER(SIZE_T) :: old_attr_namelen + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name + INTEGER(SIZE_T) :: new_attr_namelen + INTEGER(HID_T) :: lapl_id_default + + END FUNCTION h5arename_by_name_c + END INTERFACE + + obj_namelen = LEN(obj_name) + old_attr_namelen = LEN(old_attr_name) + new_attr_namelen = LEN(new_attr_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default=lapl_id + + hdferr = h5arename_by_name_c(loc_id, obj_name, obj_namelen, & + old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen, & + lapl_id_default) + + END SUBROUTINE h5arename_by_name_f + +!---------------------------------------------------------------------- +! Name: h5aopen_f +! +! Purpose: Opens an attribute for an object specified by object +! identifier and attribute name +! +! Inputs: +! obj_id - Identifer for object to which attribute is attached +! attr_name - Name of attribute to open +! Outputs: +! attr_id - attribute identifier +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! aapl_id - Attribute access property list +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5aopen_f(obj_id, attr_name, attr_id, hdferr, aapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aopen_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Attribute name + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! Success: 0 + ! Failure: -1 + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id ! Attribute access property list + INTEGER(HID_T) :: aapl_id_default + + INTEGER(SIZE_T) :: attr_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aopen_c(obj_id, attr_name, attr_namelen, aapl_id_default, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_C'::h5aopen_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(HID_T) :: aapl_id_default + INTEGER(SIZE_T) :: attr_namelen + INTEGER(HID_T), INTENT(OUT) :: attr_id + END FUNCTION h5aopen_c + END INTERFACE + + attr_namelen = LEN(attr_name) + + aapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + + hdferr = h5aopen_c(obj_id, attr_name, attr_namelen, aapl_id_default, attr_id) + + END SUBROUTINE h5aopen_f + +!---------------------------------------------------------------------- +! Name: h5adelete_by_idx_f +! +! Purpose: Deletes an attribute from an object according to index order +! +! Inputs: +! loc_id - Location or object identifier; may be dataset or group +! obj_name - Name of object, relative to location, from which attribute is to be removed +! idx_type - Type of index; Possible values are: +! +! H5_INDEX_UNKNOWN_F = -1 - Unknown index type +! H5_INDEX_NAME_F - Index on names +! H5_INDEX_CRT_ORDER_F - Index on creation order +! H5_INDEX_N_F - Number of indices defined +! +! order - Order in which to iterate over index; Possible values are: +! +! H5_ITER_UNKNOWN_F - Unknown order +! H5_ITER_INC_F - Increasing order +! H5_ITER_DEC_F - Decreasing order +! H5_ITER_NATIVE_F - No particular order, whatever is fastest +! H5_ITER_N_F - Number of iteration orders +! +! n - Offset within index +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5adelete_by_idx_f(loc_id, obj_name, idx_type, order, n, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5adelete_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, + ! from which attribute is to be removed + INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + ! H5_ITER_N_F - Number of iteration orders +! + INTEGER(HSIZE_T), INTENT(IN) :: n ! Offset within index + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5adelete_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ADELETE_BY_IDX_C'::h5adelete_by_idx_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: obj_namelen + END FUNCTION h5adelete_by_idx_c + END INTERFACE + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + obj_namelen = LEN(obj_name) + hdferr = h5adelete_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, lapl_id_default) + + END SUBROUTINE h5adelete_by_idx_f + +!---------------------------------------------------------------------- +! Name: h5adelete_by_name_f +! +! Purpose: Removes an attribute from a specified location +! +! Inputs: +! loc_id - Identifer for object to which attribute is attached +! obj_name - Name of attribute to open +! attr_name - Attribute access property list +! lapl_id - Link access property list +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5adelete_by_name_f(loc_id, obj_name, attr_name, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5adelete_by_name_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object, relative to location, + ! from which attribute is to be removed + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Name of attribute to delete + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER(SIZE_T) :: attr_namelen + INTEGER(SIZE_T) :: obj_namelen + + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5adelete_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ADELETE_BY_NAME_C'::h5adelete_by_name_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: attr_namelen + INTEGER(SIZE_T) :: obj_namelen + END FUNCTION h5adelete_by_name_c + END INTERFACE + + obj_namelen = LEN(obj_name) + attr_namelen = LEN(attr_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5adelete_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default) + + END SUBROUTINE h5adelete_by_name_f + +!---------------------------------------------------------------------- +! Name: h5aopen_by_idx_f +! +! Purpose: Opens an existing attribute that is attached to an object specified by location and name +! +! Inputs: +! loc_id - Location of object to which attribute is attached +! obj_name - Name of object to which attribute is attached, relative to location +! idx_type - Type of index +! order - Index traversal order +! n - Attribute’s position in index +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! aapl_id - Attribute access property list +! lapl_id - Link access property list +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5aopen_by_idx_f(loc_id, obj_name, idx_type, order, n, attr_id, hdferr, aapl_id, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aopen_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object to which attribute is attached + INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + + INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id ! Attribute access property list + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aopen_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, & + aapl_id_default, lapl_id_default, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_BY_IDX_C'::h5aopen_by_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + END FUNCTION h5aopen_by_idx_c + END INTERFACE + + obj_namelen = LEN(obj_name) + + aapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aopen_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, & + aapl_id_default, lapl_id_default, attr_id) + + END SUBROUTINE h5aopen_by_idx_f + +!---------------------------------------------------------------------- +! Name: h5aget_info_f +! +! Purpose: Retrieves attribute information, by attribute identifier +! +! Inputs: +! attr_id - attribute identifier +! +! Outputs: NOTE: In C it is defined as a structure: H5A_info_t +! +! corder_valid - indicates whether the creation order data is valid for this attribute +! corder - is a positive integer containing the creation order of the attribute +! cset - indicates the character set used for the attribute’s name +! data_size - indicates the size, in the number of characters, of the attribute +! +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M. S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_info_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: attr_id ! Attribute identifier + + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + + INTEGER :: corder_valid + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_info_c(attr_id, corder_valid, corder, cset, data_size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_INFO_C'::h5aget_info_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: attr_id + + INTEGER, INTENT(OUT) :: corder_valid + INTEGER, INTENT(OUT) :: corder + INTEGER, INTENT(OUT) :: cset + INTEGER(HSIZE_T), INTENT(OUT) :: data_size + END FUNCTION h5aget_info_c + END INTERFACE + + hdferr = h5aget_info_c(attr_id, corder_valid, corder, cset, data_size) + + f_corder_valid =.FALSE. + IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. + + + + END SUBROUTINE h5aget_info_f + +!---------------------------------------------------------------------- +! Name: h5aget_info_by_idx_f +! +! Purpose: Retrieves attribute information, by attribute index position +! +! Inputs: +! loc_id - Location of object to which attribute is attached +! obj_name - Name of object to which attribute is attached, relative to location +! idx_type - Type of index +! order - Index traversal order +! n - Attribute’s position in index +! +! Outputs: NOTE: In C it is defined as a structure: H5A_info_t +! corder_valid - indicates whether the creation order data is valid for this attribute +! corder - is a positive integer containing the creation order of the attribute +! cset - indicates the character set used for the attribute’s name +! data_size - indicates the size, in the number of characters, of the attribute +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5aget_info_by_idx_f(loc_id, obj_name, idx_type, order, n, & + f_corder_valid, corder, cset, data_size, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_info_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object to which attribute is attached + INTEGER, INTENT(IN) :: idx_type ! Type of index; Possible values are: + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + + INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + + + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER :: corder_valid + INTEGER(SIZE_T) :: obj_namelen + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_info_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, lapl_id_default, & + corder_valid, corder, cset, data_size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_INFO_BY_IDX_C'::h5aget_info_by_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER, INTENT(IN) :: idx_type + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) :: lapl_id_default + INTEGER, INTENT(OUT) :: corder_valid + INTEGER, INTENT(OUT) :: corder + INTEGER, INTENT(OUT) :: cset + INTEGER(HSIZE_T), INTENT(OUT) :: data_size + + INTEGER(SIZE_T) :: obj_namelen + END FUNCTION h5aget_info_by_idx_c + END INTERFACE + + obj_namelen = LEN(obj_name) + + lapl_id_default = H5P_DEFAULT_F + IF(present(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aget_info_by_idx_c(loc_id, obj_name, obj_namelen, idx_type, order, n, lapl_id_default, & + corder_valid, corder, cset, data_size) + + f_corder_valid =.FALSE. + IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. + + END SUBROUTINE h5aget_info_by_idx_f + +!---------------------------------------------------------------------- +! Name: h5aget_info_by_name_f +! +! Purpose: Retrieves attribute information, by attribute name +! +! Inputs: +! loc_id - Location of object to which attribute is attached +! obj_name - Name of object to which attribute is attached, relative to location +! attr_name - Attribute name +! +! Outputs: NOTE: In C it is defined as a structure: H5A_info_t +! corder_valid - indicates whether the creation order data is valid for this attribute +! corder - is a positive integer containing the creation order of the attribute +! cset - indicates the character set used for the attribute’s name +! data_size - indicates the size, in the number of characters, of the attribute +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5aget_info_by_name_f(loc_id, obj_name, attr_name, & + f_corder_valid, corder, cset, data_size, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aget_info_by_name_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Attribute name + + + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER :: corder_valid + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: attr_namelen + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER(HID_T) :: lapl_id_default + + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aget_info_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default, & + corder_valid, corder, cset, data_size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AGET_INFO_BY_NAME_C'::h5aget_info_by_name_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(SIZE_T), INTENT(IN) :: obj_namelen + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(SIZE_T), INTENT(IN) :: attr_namelen + INTEGER(HID_T) :: lapl_id_default + INTEGER, INTENT(OUT) :: corder_valid + INTEGER, INTENT(OUT) :: corder + INTEGER, INTENT(OUT) :: cset + INTEGER(HSIZE_T), INTENT(OUT) :: data_size + + END FUNCTION h5aget_info_by_name_c + END INTERFACE + + obj_namelen = LEN(obj_name) + attr_namelen = LEN(attr_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aget_info_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default, & + corder_valid, corder, cset, data_size) + + f_corder_valid =.FALSE. + IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. + + END SUBROUTINE h5aget_info_by_name_f + +!---------------------------------------------------------------------- +! Name: H5Acreate_by_name_f +! +! Purpose: Creates an attribute attached to a specified object +! +! Inputs: +! loc_id - Location or object identifier; may be dataset or group +! obj_name - Name, relative to loc_id, of object that attribute is to be attached to +! attr_name - Attribute name +! type_id - Attribute datatype identifier +! space_id - Attribute dataspace identifier +! +! Outputs: +! attr - an attribute identifier +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! acpl_id - Attribute creation property list identifier (Currently not used.) +! aapl_id - Attribute access property list identifier (Currently not used.) +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! February, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5acreate_by_name_f(loc_id, obj_name, attr_name, type_id, space_id, attr, hdferr, & + acpl_id, aapl_id, lapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5acreate_by_name_f +!DEC$endif + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: attr_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 ! an attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: acpl_id ! Attribute creation property list identifier (Currently not used.) + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id ! Attribute access property list identifier (Currently not used.) + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: attr_namelen + + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5acreate_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & + type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, attr) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ACREATE_BY_NAME_C'::h5acreate_by_name_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(SIZE_T), INTENT(IN) :: obj_namelen + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(SIZE_T), INTENT(IN) :: attr_namelen + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T) :: acpl_id_default + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T), INTENT(OUT) :: attr + + END FUNCTION h5acreate_by_name_c + END INTERFACE + + obj_namelen = LEN(obj_name) + attr_namelen = LEN(attr_name) + + acpl_id_default = H5P_DEFAULT_F + aapl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(acpl_id)) acpl_id_default = acpl_id + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5acreate_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & + type_id, space_id, acpl_id_default, aapl_id_default, lapl_id_default, attr) + END SUBROUTINE h5acreate_by_name_f + +!---------------------------------------------------------------------- +! Name: H5Aexists_f +! +! Purpose: Determines whether an attribute with a given name exists on an object +! +! Inputs: +! obj_id - Object identifier +! attr_name - Attribute name +! +! Outputs: +! attr_exists - attribute exists status +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M. S. Breitenfeld +! February, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5aexists_f(obj_id, attr_name, attr_exists, hdferr) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aexists_f +!DEC$endif + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Attribute name + LOGICAL, INTENT(OUT) :: attr_exists ! .TRUE. if exists, .FALSE. otherwise + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T) :: attr_exists_c + INTEGER(SIZE_T) :: attr_namelen +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aexists_c(obj_id, attr_name, attr_namelen, attr_exists_c) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AEXISTS_C'::h5aexists_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(SIZE_T) :: attr_namelen + INTEGER(HID_T) :: attr_exists_c + END FUNCTION h5aexists_c + END INTERFACE + + attr_namelen = LEN(attr_name) + + hdferr = h5aexists_c(obj_id, attr_name, attr_namelen, attr_exists_c) + + attr_exists = .FALSE. + IF(attr_exists_c.GT.0) attr_exists = .TRUE. + + END SUBROUTINE h5aexists_f + +!---------------------------------------------------------------------- +! Name: H5Aexists_by_name_f +! +! Purpose: Determines whether an attribute with a given name exists on an object +! +! Inputs: +! loc_id - Location identifier +! obj_name - Object name either relative to loc_id, absolute from the file’s root group, or '.' (a dot) +! attr_name - Attribute name +! +! Outputs: +! attr_exists - attribute exists status +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list identifier +! +! Programmer: M. S. Breitenfeld +! February, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5aexists_by_name_f(loc_id, obj_name, attr_name, attr_exists, hdferr, lapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aexists_by_name_f +!DEC$endif + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Object name either relative to loc_id, + ! absolute from the file’s root group, or '.' + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Attribute name + LOGICAL, INTENT(OUT) :: attr_exists ! .TRUE. if exists, .FALSE. otherwise + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + INTEGER :: attr_exists_c + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: attr_namelen + + INTEGER(HID_T) :: lapl_id_default +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aexists_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default, attr_exists_c) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AEXISTS_BY_NAME_C'::h5aexists_by_name_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(SIZE_T), INTENT(IN) :: obj_namelen + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(SIZE_T), INTENT(IN) :: attr_namelen + INTEGER(HID_T), INTENT(IN) :: lapl_id_default + INTEGER(HID_T), INTENT(OUT) :: attr_exists_c + END FUNCTION h5aexists_by_name_c + END INTERFACE + + attr_namelen = LEN(attr_name) + obj_namelen = LEN(obj_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aexists_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, lapl_id_default, attr_exists_c) + + attr_exists = .FALSE. + IF(attr_exists_c.GT.0) attr_exists = .TRUE. + + END SUBROUTINE h5aexists_by_name_f +!---------------------------------------------------------------------- +! Name: H5Aopen_by_name_f +! +! Purpose: Opens an attribute for an object by object name and attribute name. +! +! Inputs: +! loc_id - Location from which to find object to which attribute is attached +! obj_name - Object name either relative to loc_id, absolute from the file’s root group, or '.' (a dot) +! attr_name - Attribute name +! +! Outputs: +! attr_id - attribute identifier +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! aapl_id - Attribute access property list (Currently unused; should be passed in as H5P_DEFAULT.) +! lapl_id - Link access property list identifier +! +! Programmer: M. S. Breitenfeld +! February, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5aopen_by_name_f(loc_id, obj_name, attr_name, attr_id, hdferr, aapl_id, lapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5aopen_by_name_f +!DEC$endif + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Object name either relative to loc_id, + ! absolute from the file’s root group, or '.' + CHARACTER(LEN=*), INTENT(IN) :: attr_name ! Attribute name + INTEGER(HID_T), INTENT(OUT) :: attr_id ! Attribute identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: aapl_id ! Attribute access property list + ! (Currently unused; should be passed in as H5P_DEFAULT_F) + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: attr_namelen +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5aopen_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & + aapl_id_default, lapl_id_default, attr_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5AOPEN_BY_NAME_C'::h5aopen_by_name_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(SIZE_T), INTENT(IN) :: obj_namelen + CHARACTER(LEN=*), INTENT(IN) :: attr_name + INTEGER(SIZE_T), INTENT(IN) :: attr_namelen + INTEGER(HID_T) :: aapl_id_default + INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T), INTENT(OUT) :: attr_id + END FUNCTION h5aopen_by_name_c + END INTERFACE + + attr_namelen = LEN(attr_name) + obj_namelen = LEN(obj_name) + + aapl_id_default = H5P_DEFAULT_F + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(aapl_id)) aapl_id_default = aapl_id + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5aopen_by_name_c(loc_id, obj_name, obj_namelen, attr_name, attr_namelen, & + aapl_id_default, lapl_id_default, attr_id) + + END SUBROUTINE h5aopen_by_name_f + +!---------------------------------------------------------------------- +! Name: h5arename_f +! +! Purpose: Renames an attribute +! +! Inputs: +! loc_id - Location or object identifier; may be dataset or group +! old_attr_name - Prior attribute name +! new_attr_name - New attribute name +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5arename_f(loc_id, old_attr_name, new_attr_name, hdferr) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5arename_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Object identifier + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name ! Prior attribute name + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name ! New attribute name + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(SIZE_T) :: old_attr_namelen + INTEGER(SIZE_T) :: new_attr_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5arename_c(loc_id, & + old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5ARENAME_C'::h5arename_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: old_attr_name, new_attr_name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: old_attr_name + INTEGER(SIZE_T) :: old_attr_namelen + CHARACTER(LEN=*), INTENT(IN) :: new_attr_name + INTEGER(SIZE_T) :: new_attr_namelen + + END FUNCTION h5arename_c + END INTERFACE + + old_attr_namelen = LEN(old_attr_name) + new_attr_namelen = LEN(new_attr_name) + + hdferr = h5arename_c(loc_id, & + old_attr_name, old_attr_namelen, new_attr_name, new_attr_namelen) + + END SUBROUTINE h5arename_f + +END MODULE H5A - hdferr = h5aclose_c(attr_id) - END SUBROUTINE h5aclose_f - END MODULE H5A diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index 929a056..49f8266 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -30,10 +30,13 @@ * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal * Wednesday, August 4, 1999 - * Modifications: + * Modifications: + * - Added optional parameters introduced in version 1.8 + * February, 2008 *---------------------------------------------------------------------------*/ 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) +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 *lcpl_id, hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id) { char *c_name = NULL; hid_t c_dset_id; @@ -48,7 +51,8 @@ nh5dcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_ /* * Call H5Dcreate2 function. */ - if((c_dset_id = H5Dcreate2((hid_t)*loc_id, c_name, (hid_t)*type_id, (hid_t)*space_id, H5P_DEFAULT, (hid_t)*crt_prp, H5P_DEFAULT)) < 0) + if((c_dset_id = H5Dcreate2((hid_t)*loc_id, c_name, (hid_t)*type_id, (hid_t)*space_id, + (hid_t)*lcpl_id, (hid_t)*dcpl_id, (hid_t)*dapl_id)) < 0) goto DONE; *dset_id = (hid_t_f)c_dset_id; @@ -66,14 +70,15 @@ DONE: * Inputs: loc_id - file or group identifier * name - name of the dataset * namelen - name length + * dapl_id - Dataset access property list * Outputs: dset_id - dataset identifier * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal * Wednesday, August 4, 1999 - * Modifications: + * Modifications: Added 1.8 parameter: dapl_id *---------------------------------------------------------------------------*/ int_f -nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id) +nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f *dset_id) { char *c_name = NULL; hid_t c_dset_id; @@ -88,7 +93,7 @@ nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id) /* * Call H5Dopen2 function. */ - if((c_dset_id = H5Dopen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0) + if((c_dset_id = H5Dopen2((hid_t)*loc_id, c_name, (hid_t)*dapl_id)) < 0) goto DONE; *dset_id = (hid_t_f)c_dset_id; @@ -1257,18 +1262,21 @@ nh5dget_create_plist_c ( hid_t_f *dset_id , hid_t_f *plist_id) /*---------------------------------------------------------------------------- - * Name: h5dextend_c + * Name: h5dset_extent_c * Purpose: Call H5Dset_extent 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: + * + * Modifications: Changed name from the now obsolete h5dextend + * to h5dset_extent in order to match new fortran interface. + * -MSB- March 14, 2008 *---------------------------------------------------------------------------*/ int_f -nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims) +nh5dset_extent_c ( hid_t_f *dset_id , hsize_t_f *dims) { hid_t c_space_id; hsize_t c_dims[H5S_MAX_RANK]; @@ -1946,4 +1954,39 @@ nh5dget_space_status_c ( hid_t_f *dset_id, int_f *flag) ret_value = 0; return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5dcreate_anon_c + * Purpose: Call H5Dcreate_anon + * Inputs: + * loc_id - Identifier of the file or group within which to create the dataset. + * type_id - Identifier of the datatype to use when creating the dataset. + * space_id - Identifier of the dataspace to use when creating the dataset. + * dcpl_id - Dataset creation property list identifier. + * dapl_id - Dataset access property list identifier. + * Outputs: + * dset_id - dataset identifier + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + *---------------------------------------------------------------------------*/ +int_f +nh5dcreate_anon_c (hid_t_f *loc_id, hid_t_f *type_id, hid_t_f *space_id, + hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id) +{ + int ret_value = -1; + + /* + * Call H5Dcreate2 function. + */ + if((*dset_id = (hid_t_f)H5Dcreate_anon((hid_t)*loc_id, (hid_t)*type_id, (hid_t)*space_id, + (hid_t)*dcpl_id, (hid_t)*dapl_id)) < 0) + goto DONE; + + ret_value = 0; + + DONE: + return ret_value; +} + diff --git a/fortran/src/H5Dff.f90 b/fortran/src/H5Dff.f90 index 34bcdf4..a94339f 100644 --- a/fortran/src/H5Dff.f90 +++ b/fortran/src/H5Dff.f90 @@ -16,111 +16,115 @@ ! ! This file contains Fortran90 interfaces for H5D functions. ! - MODULE H5D - USE H5GLOBAL - - 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 Crays - 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 Crays - 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 Crays - 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 Crays - - END INTERFACE - - INTERFACE h5dwrite_vl_f - MODULE PROCEDURE h5dwrite_vl_integer - MODULE PROCEDURE h5dwrite_vl_real - MODULE PROCEDURE h5dwrite_vl_string - END INTERFACE - - INTERFACE h5dread_vl_f - MODULE PROCEDURE h5dread_vl_integer - MODULE PROCEDURE h5dread_vl_real - MODULE PROCEDURE h5dread_vl_string - END INTERFACE - - INTERFACE h5dfill_f - MODULE PROCEDURE h5dfill_integer - MODULE PROCEDURE h5dfill_real - MODULE PROCEDURE h5dfill_double - MODULE PROCEDURE h5dfill_char - END INTERFACE - - - CONTAINS +MODULE H5D + USE H5GLOBAL + + 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 Crays + 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 Crays + 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 Crays + 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 Crays + + END INTERFACE + + INTERFACE h5dwrite_vl_f + MODULE PROCEDURE h5dwrite_vl_integer + MODULE PROCEDURE h5dwrite_vl_real + MODULE PROCEDURE h5dwrite_vl_string + END INTERFACE + + INTERFACE h5dread_vl_f + MODULE PROCEDURE h5dread_vl_integer + MODULE PROCEDURE h5dread_vl_real + MODULE PROCEDURE h5dread_vl_string + END INTERFACE + + INTERFACE h5dfill_f + MODULE PROCEDURE h5dfill_integer + MODULE PROCEDURE h5dfill_real + MODULE PROCEDURE h5dfill_double + MODULE PROCEDURE h5dfill_char + END INTERFACE + + INTERFACE h5dextend_f + MODULE PROCEDURE h5dset_extent_f + END INTERFACE + + +CONTAINS !---------------------------------------------------------------------- ! Name: h5dcreate_f @@ -138,64 +142,86 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! createion_prp - dataset creation property list identifier +! creation_prp - Dataset creation property list +! lcpl_id - Link creation property list +! dapl_id - Dataset access property list ! ! Programmer: Elena Pourmal ! August 12, 1999 ! -! Modifications: Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). February 28, 2001 +! Modifications: +! - Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! - Added version's 1.8 new optional parameters +! February, 2008 ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, & - hdferr, creation_prp) + SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, & + hdferr, dcpl_id, lcpl_id, dapl_id) + !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5dcreate_f !DEC$endif - 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(HID_T) :: creation_prp_default - INTEGER :: namelen ! Name length + 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) :: dcpl_id ! Dataset creation property list + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id ! Dataset access property list + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: dcpl_id_default + INTEGER(HID_T) :: dapl_id_default + + INTEGER :: namelen ! Name length -! INTEGER, EXTERNAL :: h5dcreate_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5dcreate_c(loc_id, name, namelen, type_id, & - space_id, creation_prp_default, dset_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DCREATE_C'::h5dcreate_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER(HID_T) :: creation_prp_default - INTEGER(HID_T), INTENT(OUT) :: dset_id - END FUNCTION h5dcreate_c - END INTERFACE - - 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 + INTERFACE + INTEGER FUNCTION h5dcreate_c(loc_id, name, namelen, type_id, & + space_id, lcpl_id_default, dcpl_id_default, dapl_id_default, dset_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DCREATE_C'::h5dcreate_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: dcpl_id_default + INTEGER(HID_T) :: dapl_id_default + + INTEGER(HID_T), INTENT(OUT) :: dset_id + END FUNCTION h5dcreate_c + END INTERFACE + + lcpl_id_default = H5P_DEFAULT_F + dcpl_id_default = H5P_DEFAULT_F + dapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF(PRESENT(dcpl_id)) dcpl_id_default = dcpl_id + IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + + namelen = LEN(name) + hdferr = h5dcreate_c(loc_id, name, namelen, type_id, space_id, & + lcpl_id_default, dcpl_id_default, dapl_id_default, dset_id) + + END SUBROUTINE h5dcreate_f !---------------------------------------------------------------------- ! Name: h5dopen_f @@ -211,19 +237,22 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! NONE +! dapl_id - Dataset access property list ! ! Programmer: Elena Pourmal ! August 12, 1999 ! -! Modifications: Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). February 28, 2001 +! Modifications: -Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). February 28, 2001 +! +! -Added 1.8 (optional) parameter dapl_id +! February, 2008, M.S. Breitenfeld ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5dopen_f(loc_id, name, dset_id, hdferr) + SUBROUTINE h5dopen_f(loc_id, name, dset_id, hdferr, dapl_id) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5dopen_f @@ -231,15 +260,18 @@ 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(HID_T), INTENT(OUT) :: dset_id ! Dataset identifier INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id ! Dataset access property list INTEGER :: namelen ! Name length + INTEGER(HID_T) :: dapl_id_default + ! INTEGER, EXTERNAL :: h5dopen_c ! MS FORTRAN needs explicit interface for C functions called here. ! INTERFACE - INTEGER FUNCTION h5dopen_c(loc_id, name, namelen, dset_id) + INTEGER FUNCTION h5dopen_c(loc_id, name, namelen, dapl_id_default, dset_id) USE H5GLOBAL !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DOPEN_C'::h5dopen_c @@ -248,12 +280,16 @@ INTEGER(HID_T), INTENT(IN) :: loc_id CHARACTER(LEN=*), INTENT(IN) :: name INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: dapl_id_default INTEGER(HID_T), INTENT(OUT) :: dset_id END FUNCTION h5dopen_c END INTERFACE + dapl_id_default = H5P_DEFAULT_F + IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + namelen = LEN(name) - hdferr = h5dopen_c(loc_id, name, namelen, dset_id) + hdferr = h5dopen_c(loc_id, name, namelen, dapl_id_default, dset_id) END SUBROUTINE h5dopen_f @@ -332,7 +368,7 @@ INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default INTEGER(HADDR_T), ALLOCATABLE, DIMENSION(:) :: ref_buf - INTEGER :: i,j + INTEGER :: j ! INTEGER, EXTERNAL :: h5dwrite_ref_obj_c ! MS FORTRAN needs explicit interface for C functions called here. @@ -2499,7 +2535,7 @@ INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default INTEGER(HADDR_T), ALLOCATABLE, DIMENSION(:) :: ref_buf - INTEGER :: i,j + INTEGER :: j ! INTEGER, EXTERNAL :: h5dread_ref_obj_c ! MS FORTRAN needs explicit interface for C functions called here. @@ -4705,7 +4741,7 @@ END SUBROUTINE h5dget_type_f !---------------------------------------------------------------------- -! Name: h5dextend_f +! Name: h5dset_extent (instead of obsolete name: h5dextend_f) ! ! Purpose: Extends a dataset with unlimited dimension. ! @@ -4727,14 +4763,18 @@ ! called C functions (it is needed for Windows ! port). February 28, 2001 ! +! Changed name from the now obsolete h5dextend_f +! to h5dset_extent_f. Provided interface to old name +! for backward compatability. -MSB- March 14, 2008 +! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5dextend_f(dataset_id, size, hdferr) + SUBROUTINE H5Dset_extent_f(dataset_id, size, hdferr) !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) -!DEC$attributes dllexport :: h5dextend_f +!DEC$attributes dllexport :: H5Dset_extent_f !DEC$endif IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier @@ -4743,22 +4783,22 @@ ! dimensions' sizes INTEGER, INTENT(OUT) :: hdferr ! Error code -! INTEGER, EXTERNAL :: h5dextend_c +! INTEGER, EXTERNAL :: H5Dset_extent_c ! MS FORTRAN needs explicit interface for C functions called here. ! INTERFACE - INTEGER FUNCTION h5dextend_c(dataset_id, size) + INTEGER FUNCTION H5Dset_extent_c(dataset_id, size) USE H5GLOBAL !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DEXTEND_C'::h5dextend_c + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DSET_EXTENT_C'::H5Dset_extent_c !DEC$ ENDIF INTEGER(HID_T), INTENT(IN) :: dataset_id INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: size - END FUNCTION h5dextend_c + END FUNCTION H5Dset_extent_c END INTERFACE - hdferr = h5dextend_c(dataset_id, size) - END SUBROUTINE h5dextend_f + hdferr = H5Dset_extent_c(dataset_id, size) + END SUBROUTINE H5Dset_extent_f !---------------------------------------------------------------------- @@ -5215,7 +5255,6 @@ INTEGER(HID_T) :: mem_space_id_default INTEGER(HID_T) :: file_space_id_default ! CHARACTER, DIMENSION(dims(1)*dims(2)) :: tmp_buf - integer i, j INTERFACE INTEGER FUNCTION h5dwrite_vl_string_c(dset_id, mem_type_id, & @@ -5646,4 +5685,79 @@ hdferr = h5dget_space_status_c(dset_id, flag) END SUBROUTINE h5dget_space_status_f - END MODULE H5D +!---------------------------------------------------------------------- +! Name: h5dcreate_anon_f +! +! Purpose: Creates a dataset in a file without linking it into the file structure +! +! Inputs: +! loc_id - Identifier of the file or group within which to create the dataset. +! type_id - Identifier of the datatype to use when creating the dataset. +! space_id - Identifier of the dataspace to use when creating the dataset. +! Outputs: +! dset_id - dataset identifier +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! dcpl_id - Dataset creation property list identifier. +! dapl_id - Dataset access property list identifier. +! +! Programmer: M.S. Breitenfeld +! February 11, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5dcreate_anon_f(loc_id, type_id, space_id, dset_id, hdferr, dcpl_id, dapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5dcreate_anon_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier. + 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) :: dcpl_id ! Dataset creation property list identifier. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: dapl_id ! Dataset access property list identifier. + + INTEGER(HID_T) :: dcpl_id_default + INTEGER(HID_T) :: dapl_id_default + +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5dcreate_anon_c(loc_id, type_id, space_id, dcpl_id_default, dapl_id_default, dset_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DCREATE_ANON_C'::h5dcreate_anon_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HID_T) :: dcpl_id_default + INTEGER(HID_T) :: dapl_id_default + INTEGER(HID_T), INTENT(OUT) :: dset_id + END FUNCTION h5dcreate_anon_c + END INTERFACE + + dcpl_id_default = H5P_DEFAULT_F + dapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(dcpl_id)) dcpl_id_default = dcpl_id + IF(PRESENT(dapl_id)) dapl_id_default = dapl_id + + hdferr = h5dcreate_anon_c(loc_id, type_id, space_id, dcpl_id_default, dapl_id_default, dset_id) + + END SUBROUTINE h5dcreate_anon_f + +END MODULE H5D + + diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c index 575d92b..2190d05 100644 --- a/fortran/src/H5Ff.c +++ b/fortran/src/H5Ff.c @@ -508,7 +508,7 @@ nh5fget_name_c(hid_t_f *obj_id, size_t_f *size, _fcd buf, size_t_f *buflen) HGOTO_DONE(FAIL); /* - * Call H5Aget_name function + * Call H5Fget_name function */ if ((size_c = (size_t_f)H5Fget_name((hid_t)*obj_id, c_buf, (size_t)*buflen)) < 0) HGOTO_DONE(FAIL); diff --git a/fortran/src/H5Fff.f90 b/fortran/src/H5Fff.f90 index 3926656..6cf6c05 100644 --- a/fortran/src/H5Fff.f90 +++ b/fortran/src/H5Fff.f90 @@ -58,14 +58,14 @@ !DEC$endif ! - IMPLICIT NONE + 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 + ! list identifier INTEGER(HID_T), OPTIONAL, INTENT(IN) :: access_prp ! File access property list ! identifier diff --git a/fortran/src/H5Gf.c b/fortran/src/H5Gf.c index 0316c03..f2a4187 100644 --- a/fortran/src/H5Gf.c +++ b/fortran/src/H5Gf.c @@ -16,6 +16,7 @@ /* This files contains C stubs for H5G Fortran APIs */ #include "H5f90.h" +#include "H5Eprivate.h" /*---------------------------------------------------------------------------- * Name: h5gcreate_c @@ -35,9 +36,9 @@ *---------------------------------------------------------------------------*/ int_f nh5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, - hid_t_f *grp_id) + hid_t_f *grp_id, hid_t_f *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id ) { - hid_t gcpl_id = -1; /* Group creation property list */ + hid_t c_gcpl_id = -1; /* Group creation property list */ char *c_name = NULL; hid_t c_grp_id; int_f ret_value = -1; @@ -51,19 +52,19 @@ nh5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, /* * Call H5Gcreate function. */ - if(*size_hint == OBJECT_NAMELEN_DEFAULT_F ) - c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); + if(*size_hint == OBJECT_NAMELEN_DEFAULT_F ){ + c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name,(hid_t)*lcpl_id,(hid_t)*gcpl_id,(hid_t)*gapl_id);} else { - /* Create the group creation property list */ - if((gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 0) - goto DONE; + /* Create the group creation property list */ + if((c_gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 0) + goto DONE; - /* Set the local heap size hint */ - if(H5Pset_local_heap_size_hint(gcpl_id, (size_t)*size_hint) < 0) - goto DONE; + /* Set the local heap size hint */ + if(H5Pset_local_heap_size_hint(c_gcpl_id, (size_t)*size_hint) < 0) + goto DONE; - /* Create the group */ - c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, gcpl_id, H5P_DEFAULT); + /* Create the group */ + c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, c_gcpl_id, H5P_DEFAULT); } if(c_grp_id < 0) goto DONE; @@ -73,8 +74,8 @@ nh5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, ret_value = 0; DONE: - if(gcpl_id > 0) - H5Pclose(gcpl_id); + if(c_gcpl_id > 0) + H5Pclose(c_gcpl_id); if(c_name) HDfree(c_name); return ret_value; @@ -86,6 +87,7 @@ DONE: * Inputs: loc_id - file or group identifier * name - name of the group * namelen - name length + * gapl_id - Group access property list identifier * Outputs: grp_id - group identifier * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal @@ -93,7 +95,7 @@ DONE: * Modifications: *---------------------------------------------------------------------------*/ int_f -nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id) +nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *gapl_id, hid_t_f *grp_id) { char *c_name = NULL; hid_t c_grp_id; @@ -108,7 +110,7 @@ nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id) /* * Call H5Gopen function. */ - if((c_grp_id = H5Gopen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0) + if((c_grp_id = H5Gopen2((hid_t)*loc_id, c_name, (hid_t)*gapl_id)) < 0) goto DONE; /* Everything OK, set values to return */ @@ -659,3 +661,210 @@ DONE: return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5gcreate_anon_c + * Purpose: Call H5Gcreate_anon + * Inputs: + * loc_id - Location identifier + * gcpl_id - Group creation property list identifier + * gapl_id - Group access property list identifier + * + * Outputs: grp_id - group identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 15, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gcreate_anon_c(hid_t_f *loc_id, hid_t_f *gcpl_id, hid_t_f *gapl_id, hid_t_f *grp_id) +{ + + int_f ret_value=0; /* Return value */ + + if ((*grp_id = (hid_t_f)H5Gcreate_anon((hid_t)*loc_id,(hid_t)*gcpl_id,(hid_t)*gapl_id)) < 0) + HGOTO_DONE(FAIL); + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5gget_create_plist_c + * Purpose: Call H5Gget_create_plist + * Inputs: + * grp_id - group identifier + * + * Outputs: gcpl_id - Group creation property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 15, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5gget_create_plist_c(hid_t_f *grp_id, hid_t_f *gcpl_id ) +{ + int_f ret_value=0; /* Return value */ + + if ((*gcpl_id = (hid_t_f)H5Gget_create_plist((hid_t)*grp_id)) < 0) + HGOTO_DONE(FAIL); + +done: + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5gget_info_c + * Purpose: Call H5Gget_info + * Inputs: group_id - Group identifier + * Outputs: + * storage_type - Type of storage for links in group: + * H5G_STORAGE_TYPE_COMPACT: Compact storage + * H5G_STORAGE_TYPE_DENSE: Indexed storage + * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure + * + * nlinks - Number of links in group + * max_corder - Current maximum creation order value for group + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 15, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5gget_info_c (hid_t_f *group_id, int_f *storage_type, int_f *nlinks, int_f *max_corder) +{ + + int_f ret_value = 0; /* Return value */ + H5G_info_t ginfo; + + /* + * Call H5Gget_info function. + */ + if(H5Gget_info((hid_t)*group_id,&ginfo) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *storage_type = (int_f)ginfo.storage_type; + *nlinks = (int_f)ginfo.nlinks; + *max_corder = (int_f)ginfo.max_corder; + +done: + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5gget_info_by_idx_c + * Purpose: Call H5Gget_info_by_idx + * Inputs: + * loc_id - File or group identifier + * group_name - Name of group containing group for which information is to be retrieved + * group_namelen - name length + * index_type - Index type + * order - Order of the count in the index + * n - Position in the index of the group for which information is retrieved + * lapl_id - Link access property list + * Outputs: + * storage_type - Type of storage for links in group: + * H5G_STORAGE_TYPE_COMPACT: Compact storage + * H5G_STORAGE_TYPE_DENSE: Indexed storage + * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure + * + * nlinks - Number of links in group + * max_corder - Current maximum creation order value for group + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 18, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + hid_t_f *index_type, hid_t_f *order, hsize_t_f *n, hid_t_f *lapl_id, + int_f *storage_type, int_f *nlinks, int_f *max_corder) + +{ + char *c_group_name = NULL; /* Buffer to hold group name C string */ + int_f ret_value = 0; /* Return value */ + H5G_info_t ginfo; + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Gget_info_by_idx function. + */ + if(H5Gget_info_by_idx((hid_t)*loc_id,c_group_name, (H5_index_t)*index_type,(H5_iter_order_t)*order,(hsize_t)*n, + &ginfo, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *storage_type = (int_f)ginfo.storage_type; + *nlinks = (int_f)ginfo.nlinks; + *max_corder = (int_f)ginfo.max_corder; + + done: + if(c_group_name) + HDfree(c_group_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5gget_info_by_name_c + * Purpose: Call H5Gget_info_by_name + * Inputs: + * loc_id - File or group identifier + * group_name - Name of group containing group for which information is to be retrieved + * group_namelen - name length + * lapl_id - Link access property list + * Outputs: + * storage_type - Type of storage for links in group: + * H5G_STORAGE_TYPE_COMPACT: Compact storage + * H5G_STORAGE_TYPE_DENSE: Indexed storage + * H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure + * + * nlinks - Number of links in group + * max_corder - Current maximum creation order value for group + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 18, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5gget_info_by_name_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, hid_t_f *lapl_id, + int_f *storage_type, int_f *nlinks, int_f *max_corder) + +{ + char *c_group_name = NULL; /* Buffer to hold group name C string */ + int_f ret_value = 0; /* Return value */ + H5G_info_t ginfo; + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Gget_info_by_name function. + */ + if(H5Gget_info_by_name((hid_t)*loc_id, c_group_name, &ginfo, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *storage_type = (int_f)ginfo.storage_type; + *nlinks = (int_f)ginfo.nlinks; + *max_corder = (int_f)ginfo.max_corder; + + done: + if(c_group_name) + HDfree(c_group_name); + return ret_value; +} + diff --git a/fortran/src/H5Gff.f90 b/fortran/src/H5Gff.f90 index 5866539..6e4dd4f 100644 --- a/fortran/src/H5Gff.f90 +++ b/fortran/src/H5Gff.f90 @@ -16,10 +16,18 @@ ! ! This file contains Fortran90 interfaces for H5F functions. ! - MODULE H5G - USE H5GLOBAL - - CONTAINS +MODULE H5G + USE H5GLOBAL + +! PRIVATE :: h5gcreate1_f +! PRIVATE :: h5gcreate2_f + +! INTERFACE h5gcreate_f +! MODULE PROCEDURE h5gcreate1_f +! MODULE PROCEDURE h5gcreate2_f +! END INTERFACE + +CONTAINS !---------------------------------------------------------------------- ! Name: h5gcreate_f @@ -35,9 +43,12 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! size_hint - a parameter indicating the number of bytes +! size_hint - a parameter indicating the number of bytes ! to reserve for the names that will appear ! in the group +! lcpl_id - Property list for link creation +! gcpl_id - Property list for group creation +! gapl_id - Property list for group access ! ! Programmer: Elena Pourmal ! August 12, 1999 @@ -46,56 +57,170 @@ ! called C functions (it is needed for Windows ! port). March 5, 2001 ! +! Added additional optional paramaters in 1.8 +! MSB - February 27, 2008 +! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5gcreate_f(loc_id, name, grp_id, hdferr, size_hint) + SUBROUTINE h5gcreate_f(loc_id, name, grp_id, hdferr, size_hint, lcpl_id, gcpl_id, gapl_id) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5gcreate_f !DEC$endif -! - - 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 +! + 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. Set to OBJECT_NAMELEN_DEFAULT_F + ! if using any of the optional + ! parameters lcpl_id, gcpl_id, and/or gapl_id when not + ! using keywords in specifying the optional parameters + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Property list for link creation + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gcpl_id ! Property list for group creation + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id ! Property list for group access + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: gcpl_id_default + INTEGER(HID_T) :: gapl_id_default + + INTEGER :: namelen ! Length of the name character string + INTEGER(SIZE_T) :: size_hint_default -! INTEGER, EXTERNAL :: h5gcreate_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5gcreate_c(loc_id, name, namelen, & - size_hint_default, grp_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GCREATE_C'::h5gcreate_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(SIZE_T) :: size_hint_default - INTEGER(HID_T), INTENT(OUT) :: grp_id - END FUNCTION h5gcreate_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5gcreate_c(loc_id, name, namelen, & + size_hint_default, grp_id, lcpl_id_default, gcpl_id_default, gapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GCREATE_C'::h5gcreate_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(SIZE_T) :: size_hint_default + INTEGER(HID_T), INTENT(OUT) :: grp_id + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: gcpl_id_default + INTEGER(HID_T) :: gapl_id_default + END FUNCTION h5gcreate_c + END INTERFACE - 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) + size_hint_default = OBJECT_NAMELEN_DEFAULT_F + IF (PRESENT(size_hint)) size_hint_default = size_hint + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + gcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id + gapl_id_default = H5P_DEFAULT_F + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + + namelen = LEN(name) + + hdferr = h5gcreate_c(loc_id, name, namelen, size_hint_default, grp_id, & + lcpl_id_default, gcpl_id_default, gapl_id_default) + + END SUBROUTINE h5gcreate_f + +!!$!---------------------------------------------------------------------- +!!$! Name: h5gcreate2_f +!!$! +!!$! Purpose: Creates a new group. +!!$! +!!$! Inputs: +!!$! loc_id - location identifier +!!$! name - group name at the specified location +!!$! Outputs: +!!$! grp_id - group identifier +!!$! hdferr: - error code +!!$! Success: 0 +!!$! Failure: -1 +!!$! Optional parameters: +!!$! +!!$! lcpl_id - Property list for link creation +!!$! gcpl_id - Property list for group creation +!!$! gapl_id - Property list for group access +!!$! +!!$! Programmer: M.S. BREITENFELD +!!$! February 27, 2008 +!!$! +!!$! Modifications: +!!$! +!!$! Comment: Needed to switch the first 2 arguments to avoid conflect +!!$! with h5gcreate1_f +!!$!---------------------------------------------------------------------- +!!$ +!!$ SUBROUTINE h5gcreate2_f(name, loc_id, grp_id, hdferr, & +!!$ lcpl_id, gcpl_id, gapl_id) +!!$! +!!$!This definition is needed for Windows DLLs +!!$!DEC$if defined(BUILD_HDF5_DLL) +!!$!DEC$attributes dllexport :: h5gcreate_f +!!$!DEC$endif +!!$! +!!$ IMPLICIT NONE +!!$ CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group +!!$ INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier +!!$ INTEGER, INTENT(OUT) :: hdferr ! Error code +!!$ INTEGER(HID_T), INTENT(OUT) :: grp_id ! Group identifier +!!$ +!!$ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Property list for link creation +!!$ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gcpl_id ! Property list for group creation +!!$ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id ! Property list for group access +!!$ +!!$ INTEGER(HID_T) :: lcpl_id_default +!!$ INTEGER(HID_T) :: gcpl_id_default +!!$ INTEGER(HID_T) :: gapl_id_default +!!$ +!!$ INTEGER(SIZE_T) :: OBJECT_NAMELEN_DEFAULT ! Dummy argument to pass to c call +!!$ INTEGER :: namelen ! Length of the name character string +!!$ +!!$! MS FORTRAN needs explicit interface for C functions called here. +!!$! +!!$ INTERFACE +!!$ INTEGER FUNCTION h5gcreate_c(loc_id, name, namelen, & +!!$ OBJECT_NAMELEN_DEFAULT, grp_id, lcpl_id_default, gcpl_id_default, gapl_id_default) +!!$ USE H5GLOBAL +!!$ !DEC$ IF DEFINED(HDF5F90_WINDOWS) +!!$ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GCREATE_C'::h5gcreate_c +!!$ !DEC$ ENDIF +!!$ !DEC$ATTRIBUTES reference :: name +!!$ INTEGER(HID_T), INTENT(IN) :: loc_id +!!$ CHARACTER(LEN=*), INTENT(IN) :: name +!!$ INTEGER :: namelen +!!$ INTEGER(SIZE_T) :: OBJECT_NAMELEN_DEFAULT +!!$ INTEGER(HID_T) :: lcpl_id_default +!!$ INTEGER(HID_T) :: gcpl_id_default +!!$ INTEGER(HID_T) :: gapl_id_default +!!$ INTEGER(HID_T), INTENT(OUT) :: grp_id +!!$ END FUNCTION h5gcreate_c +!!$ END INTERFACE +!!$ +!!$ namelen = LEN(name) +!!$ OBJECT_NAMELEN_DEFAULT = OBJECT_NAMELEN_DEFAULT_F +!!$ +!!$ lcpl_id_default = H5P_DEFAULT_F +!!$ IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id +!!$ gcpl_id_default = H5P_DEFAULT_F +!!$ IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id +!!$ gapl_id_default = H5P_DEFAULT_F +!!$ IF(PRESENT(gapl_id)) gapl_id_default = gapl_id +!!$ +!!$ +!!$ hdferr = h5gcreate_c(loc_id, name, namelen, OBJECT_NAMELEN_DEFAULT, grp_id, & +!!$ lcpl_id_default, gcpl_id_default, gapl_id_default) +!!$ +!!$ END SUBROUTINE h5gcreate2_f - END SUBROUTINE h5gcreate_f !---------------------------------------------------------------------- ! Name: h5gopen_f @@ -111,54 +236,62 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! NONE +! gapl_id - Group access property list identifier ! ! Programmer: Elena Pourmal ! August 12, 1999 ! ! Modifications: Explicit Fortran interfaces were added for ! called C functions (it is needed for Windows -! port). March 5, 2001 +! port). March 5, 2001 +! +! Added 1.8 (optional) parameter gapl_id +! February, 2008 M.S. Breitenfeld ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5gopen_f(loc_id, name, grp_id, hdferr) + SUBROUTINE h5gopen_f(loc_id, name, grp_id, hdferr, gapl_id) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5gopen_f !DEC$endif ! - - 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 - + 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(HID_T), OPTIONAL, INTENT(IN) :: gapl_id ! Group access property list identifier + + INTEGER(HID_T) :: gapl_id_default + INTEGER :: namelen ! Length of the name character string + ! INTEGER, EXTERNAL :: h5gopen_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5gopen_c(loc_id, name, namelen, grp_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GOPEN_C'::h5gopen_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(OUT) :: grp_id - END FUNCTION h5gopen_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5gopen_c(loc_id, name, namelen, grp_id) + INTERFACE + INTEGER FUNCTION h5gopen_c(loc_id, name, namelen, gapl_id_default, grp_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GOPEN_C'::h5gopen_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: gapl_id_default + INTEGER(HID_T), INTENT(OUT) :: grp_id + END FUNCTION h5gopen_c + END INTERFACE - END SUBROUTINE h5gopen_f + gapl_id_default = H5P_DEFAULT_F + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + + namelen = LEN(name) + hdferr = h5gopen_c(loc_id, name, namelen, gapl_id_default, grp_id) + + END SUBROUTINE h5gopen_f !---------------------------------------------------------------------- ! Name: h5gclose_f @@ -929,7 +1062,362 @@ namelen = LEN(name) hdferr = h5gget_comment_c(loc_id, name, namelen, size, buffer) - END SUBROUTINE h5gget_comment_f + END SUBROUTINE h5gget_comment_f + +!---------------------------------------------------------------------- +! Name: H5Gcreate_anon_f +! +! Purpose: Creates a new empty group without linking it into the file structure. +! +! Inputs: +! loc_id - Location identifier +! Outputs: +! grp_id - group identifier +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! gcpl_id - Group creation property list identifier +! gapl_id - Group access property list identifier +! +! Programmer: M.S. Breitenfeld +! February 15, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5Gcreate_anon_f(loc_id, grp_id, hdferr, gcpl_id, gapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gcreate_anon_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + INTEGER(HID_T), INTENT(OUT) :: grp_id ! Group identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gcpl_id ! Property list for group creation + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: gapl_id ! Property list for group access + + INTEGER(HID_T) :: gcpl_id_default + INTEGER(HID_T) :: gapl_id_default + + INTERFACE + INTEGER FUNCTION h5gcreate_anon_c(loc_id, gcpl_id_default, gapl_id_default, grp_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GCREATE_ANON_C'::h5gcreate_anon_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + INTEGER(HID_T), INTENT(IN) :: gcpl_id_default ! Property list for group creation + INTEGER(HID_T), INTENT(IN) :: gapl_id_default ! Property list for group access + INTEGER(HID_T), INTENT(OUT) :: grp_id ! Group identifier + END FUNCTION h5gcreate_anon_c + END INTERFACE + + gcpl_id_default = H5P_DEFAULT_F + gapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(gcpl_id)) gcpl_id_default = gcpl_id + IF(PRESENT(gapl_id)) gapl_id_default = gapl_id + + hdferr = h5gcreate_anon_c(loc_id, gcpl_id_default, gapl_id_default, grp_id) + + END SUBROUTINE h5Gcreate_anon_f + +!---------------------------------------------------------------------- +! Name: H5Gget_create_plist_f +! +! Purpose: Gets a group creation property list identifier. +! +! Inputs: +! grp_id - group identifier +! Outputs: +! gcpl_id - Group creation property list identifier +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! +! Programmer: M.S. Breitenfeld +! February 15, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5gget_create_plist_f(grp_id, gcpl_id, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gget_create_plist_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: grp_id ! Group identifier + INTEGER(HID_T), INTENT(OUT) :: gcpl_id ! Property list for group creation + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5gget_create_plist_c(grp_id, gcpl_id ) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GGET_CREATE_PLIST_C'::h5gget_create_plist_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: grp_id + INTEGER(HID_T), INTENT(OUT) :: gcpl_id + END FUNCTION h5gget_create_plist_c + END INTERFACE + + hdferr = h5gget_create_plist_c(grp_id, gcpl_id ) + + END SUBROUTINE h5gget_create_plist_f + +!---------------------------------------------------------------------- +! Name: h5gget_info_f +! +! Purpose: Retrieves information about a group +! +! Inputs: +! group_id - Group identifier +! +! Outputs: NOTE: In C it is defined as a structure: H5G_info_t +! +! storage_type - Type of storage for links in group +! H5G_STORAGE_TYPE_COMPACT: Compact storage +! H5G_STORAGE_TYPE_DENSE: Indexed storage +! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure +! nlinks - Number of links in group +! max_corder - Current maximum creation order value for group +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M. S. Breitenfeld +! February 15, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5gget_info_f(group_id, storage_type, nlinks, max_corder, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gget_info_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: group_id ! Group identifier + + INTEGER, INTENT(OUT) :: storage_type ! Type of storage for links in group: + ! H5G_STORAGE_TYPE_COMPACT_F: Compact storage + ! H5G_STORAGE_TYPE_DENSE_F: Indexed storage + ! H5G_STORAGE_TYPE_SYMBOL_TABLE_F: Symbol tables, the original HDF5 structure + INTEGER, INTENT(OUT) :: nlinks ! Number of links in group + INTEGER, INTENT(OUT) :: max_corder ! Current maximum creation order value for group + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5gget_info_c(group_id, storage_type, nlinks, max_corder) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GGET_INFO_C'::h5gget_info_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: group_id + INTEGER, INTENT(OUT) :: storage_type + INTEGER, INTENT(OUT) :: nlinks + INTEGER, INTENT(OUT) :: max_corder + END FUNCTION h5gget_info_c + END INTERFACE + + hdferr = h5gget_info_c(group_id, storage_type, nlinks, max_corder) + + END SUBROUTINE h5gget_info_f + +!---------------------------------------------------------------------- +! Name: h5gget_info_by_idx_f +! +! Purpose: Retrieves information about a group, according to the group’s position within an index. +! +! Inputs: +! loc_id - File or group identifier +! group_name - Name of group containing group for which information is to be retrieved +! index_type - Index type +! order - Order of the count in the index +! n - Position in the index of the group for which information is retrieved +! +! Outputs: NOTE: In C the following are defined as a structure: H5G_info_t +! +! storage_type - Type of storage for links in group +! H5G_STORAGE_TYPE_COMPACT: Compact storage +! H5G_STORAGE_TYPE_DENSE: Indexed storage +! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure +! nlinks - Number of links in group +! max_corder - Current maximum creation order value for group +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! February 18, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5gget_info_by_idx_f(loc_id, group_name, index_type, order, n, & + storage_type, nlinks, max_corder, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gget_info_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of group containing group for which information is to be retrieved + INTEGER(HID_T), INTENT(IN) :: index_type ! Index type + INTEGER(HID_T), INTENT(IN) :: order ! Order of the count in the index + INTEGER(HSIZE_T), INTENT(IN) :: n ! Position in the index of the group for which information is retrieved + + INTEGER, INTENT(OUT) :: storage_type ! Type of storage for links in group: + ! H5G_STORAGE_TYPE_COMPACT_F: Compact storage + ! H5G_STORAGE_TYPE_DENSE_F: Indexed storage + ! H5G_STORAGE_TYPE_SYMBOL_TABLE_F: Symbol tables, the original HDF5 structure + INTEGER, INTENT(OUT) :: nlinks ! Number of links in group + INTEGER, INTENT(OUT) :: max_corder ! Current maximum creation order value for group + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: group_name_len ! length of group name + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5gget_info_by_idx_c(loc_id, group_name, group_name_len, index_type, order, n, lapl_id_default, & + storage_type, nlinks, max_corder) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GGET_INFO_BY_IDX_C'::h5gget_info_by_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(HID_T), INTENT(IN) :: index_type + INTEGER(HID_T), INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) :: lapl_id_default + INTEGER, INTENT(OUT) :: storage_type + INTEGER, INTENT(OUT) :: nlinks + INTEGER, INTENT(OUT) :: max_corder + + INTEGER(SIZE_T) :: group_name_len + + END FUNCTION h5gget_info_by_idx_c + END INTERFACE + + group_name_len = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(present(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5gget_info_by_idx_c(loc_id, group_name, group_name_len, & + index_type, order, n, lapl_id_default, & + storage_type, nlinks, max_corder) + + END SUBROUTINE h5gget_info_by_idx_f + +!---------------------------------------------------------------------- +! Name: h5gget_info_by_name_f +! +! Purpose: Retrieves information about a group. +! +! Inputs: +! loc_id - File or group identifier +! group_name - Name of group containing group for which information is to be retrieved +! +! Outputs: NOTE: In C the following are defined as a structure: H5G_info_t +! +! storage_type - Type of storage for links in group +! H5G_STORAGE_TYPE_COMPACT: Compact storage +! H5G_STORAGE_TYPE_DENSE: Indexed storage +! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure +! nlinks - Number of links in group +! max_corder - Current maximum creation order value for group +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! February 18, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5gget_info_by_name_f(loc_id, group_name, & + storage_type, nlinks, max_corder, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5gget_info_by_name_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of group containing group for which information is to be retrieved + + INTEGER, INTENT(OUT) :: storage_type ! Type of storage for links in group: + ! H5G_STORAGE_TYPE_COMPACT_F: Compact storage + ! H5G_STORAGE_TYPE_DENSE_F: Indexed storage + ! H5G_STORAGE_TYPE_SYMBOL_TABLE_F: Symbol tables, the original HDF5 structure + INTEGER, INTENT(OUT) :: nlinks ! Number of links in group + INTEGER, INTENT(OUT) :: max_corder ! Current maximum creation order value for group + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: group_name_len ! length of group name + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5gget_info_by_name_c(loc_id, group_name, group_name_len, lapl_id_default, & + storage_type, nlinks, max_corder) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GGET_INFO_BY_NAME_C'::h5gget_info_by_name_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(HID_T), INTENT(IN) :: lapl_id_default + INTEGER, INTENT(OUT) :: storage_type + INTEGER, INTENT(OUT) :: nlinks + INTEGER, INTENT(OUT) :: max_corder + + INTEGER(SIZE_T) :: group_name_len + + END FUNCTION h5gget_info_by_name_c + END INTERFACE + + group_name_len = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + hdferr = h5gget_info_by_name_c(loc_id, group_name, group_name_len, lapl_id_default, & + storage_type, nlinks, max_corder) + + END SUBROUTINE h5gget_info_by_name_f - END MODULE H5G +END MODULE H5G diff --git a/fortran/src/H5If.c b/fortran/src/H5If.c index d948259..b4c7660 100644 --- a/fortran/src/H5If.c +++ b/fortran/src/H5If.c @@ -54,7 +54,11 @@ nh5iget_type_c (hid_t_f *obj_id, int_f *type) * Returns: length of the name on success, -1 on failure * Programmer: Elena Pourmal * Wednesday, March 12, 2003 - * Modifications: + * Modifications: + * Changed the size of c_buf_size to c_buf_size + 1, which + * fixes the problem of truncating the string by 1 if the + * exact size of the string (buf_size) is passed in. + * M.S. Breitenfeld, April 21, 2008 *---------------------------------------------------------------------------*/ int_f nh5iget_name_c(hid_t_f *obj_id, _fcd buf, size_t_f *buf_size, size_t_f *name_size) @@ -68,8 +72,8 @@ nh5iget_name_c(hid_t_f *obj_id, _fcd buf, size_t_f *buf_size, size_t_f *name_siz /* * Allocate buffer to hold name of an attribute */ - c_buf_size = (size_t)*buf_size; - c_buf = (char *)HDmalloc(c_buf_size +1); + c_buf_size = (size_t)*buf_size +1; + c_buf = (char *)HDmalloc(c_buf_size); if (c_buf == NULL) return ret_value; /* @@ -82,7 +86,7 @@ nh5iget_name_c(hid_t_f *obj_id, _fcd buf, size_t_f *buf_size, size_t_f *name_siz /* * Convert C name to FORTRAN and place it in the given buffer */ - HD5packFstring(c_buf, _fcdtocp(buf), c_buf_size); + HD5packFstring(c_buf, _fcdtocp(buf), c_buf_size-1); *name_size = (size_t_f)c_size; ret_value = 0; diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c new file mode 100644 index 0000000..208ad19 --- /dev/null +++ b/fortran/src/H5Lf.c @@ -0,0 +1,817 @@ +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * Copyright by The HDF Group. * + * Copyright by the Board of Trustees of the University of Illinois. * + * All rights reserved. * + * * + * This file is part of HDF5. The full HDF5 copyright notice, including * + * terms governing use, modification, and redistribution, is contained in * + * the files COPYING and Copyright.html. COPYING can be found at the root * + * of the source code distribution tree; Copyright.html can be found at the * + * root level of an installed copy of the electronic HDF5 document set and * + * is linked from the top-level documents page. It can also be found at * + * http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * + * access to either file, you may request a copy from help@hdfgroup.org. * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +/* This files contains C stubs for H5L Fortran APIs */ + +#include "H5f90.h" +#include "H5Eprivate.h" + +/*---------------------------------------------------------------------------- + * Name: h5lcopy_c + * Purpose: Call H5Lcopy + * Inputs: + * src_loc_id - Location identifier of the source link + * src_name - Name of the link to be copied + * src_namelen - length of the name + * dest_loc_id - Location identifier specifying the destination of the copy + * dest_name - Name to be assigned to the NEW copy + * dest_namelen - Length of the name + * loc_id - Identifier of the file or group containing the object + * name - Name of the link to delete + * lcpl_id - Link creation property list identifier + * lapl_id - Link access property list identifier + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5lcopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, + _fcd dest_name, size_t_f *dest_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id) +{ + char *c_src_name = NULL; + char *c_dest_name = NULL; + int ret_value = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_src_name = HD5f2cstring(src_name, (size_t)*src_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_dest_name = HD5f2cstring(dest_name, (size_t)*dest_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lcopy function. + */ + if( H5Lcopy( (hid_t)*src_loc_id, c_src_name, (hid_t) *dest_loc_id, + c_dest_name, (hid_t)*lcpl_id, (hid_t)*lapl_id ) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_src_name) + HDfree(c_src_name); + if(c_dest_name) + HDfree(c_dest_name); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lcreate_external_c + * Purpose: Call H5Lcreate_external_c + * Inputs: + * file_name - Name of the file containing the target object. Neither the file nor the target object is + * required to exist. May be the file the link is being created in. + * obj_name - Path within the target file to the target object. + * link_loc_id - The file or group identifier for the new link. + * link_name - The name of the new link. + * lcpl_id - Link creation property list identifier. + * lapl_id - Link access property list identifier. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 29, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5lcreate_external_c(_fcd file_name, size_t_f *file_namelen, _fcd obj_name, size_t_f *obj_namelen, + hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id) + +{ + char *c_file_name = NULL; + char *c_obj_name = NULL; + char *c_link_name = NULL; + int ret_value = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_file_name = HD5f2cstring(file_name, (size_t)*file_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lcopy function. + */ + if( H5Lcreate_external( c_file_name, c_obj_name, (hid_t) *link_loc_id, c_link_name, + (hid_t) *lcpl_id, (hid_t) *lapl_id) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_file_name) + HDfree(c_file_name); + if(c_obj_name) + HDfree(c_obj_name); + if(c_link_name) + HDfree(c_link_name); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5ldelete_c + * Purpose: Call H5Ldelete + * Inputs: + * + * loc_id - Identifier of the file or group containing the object + * name - Name of the link to delete + * lapl_id - Link access property list identifier + * namelen - length of name + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5ldelete_c ( hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id ) +{ + char *c_name = NULL; + int ret_value = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Ldelete function. + */ + if( H5Ldelete( (hid_t)*loc_id, c_name, (hid_t)*lapl_id ) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_name) + HDfree(c_name); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lcreate_soft_c + * Purpose: Call H5Lcreate_soft + * Inputs: + * + * target_path - Path to the target object, which is not required to exist. + * link_loc_id - The file or group identifier for the new link. + * link_name - The name of the new link. + * lcpl_id - Link creation property list identifier. + * lapl_id - Link access property list identifier. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 20, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5lcreate_soft_c(_fcd target_path, size_t_f *target_path_len, + hid_t_f *link_loc_id, + _fcd link_name, size_t_f *link_name_len, + hid_t_f *lcpl_id, hid_t_f *lapl_id ) +{ + char *c_target_path = NULL; + char *c_link_name = NULL; + int ret_value = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_target_path = HD5f2cstring(target_path, (size_t)*target_path_len)) == NULL) + HGOTO_DONE(FAIL); + if((c_link_name = HD5f2cstring(link_name, (size_t)*link_name_len)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Adelete function. + */ + if ( H5Lcreate_soft(c_target_path,(hid_t)*link_loc_id, c_link_name, (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_target_path) + HDfree(c_target_path); + if(c_link_name) + HDfree(c_link_name); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lcreate_hard_c + * Purpose: Call H5Lcreate_hard + * Inputs: + * obj_loc_id - The file or group identifier for the target object. + * obj_name - Name of the target object, which must already exist. + * obj_namelen - Name length + * link_loc_id - The file or group identifier for the new link. + * link_name - The name of the new link. + * link_namelen- Name length + * lcpl_id - Link creation property list identifier. + * lapl_id - Link access property list identifier. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 27, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5lcreate_hard_c(hid_t_f *obj_loc_id, _fcd obj_name, size_t_f *obj_namelen, + hid_t_f *link_loc_id, + _fcd link_name, size_t_f *link_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id ) +{ + char *c_obj_name = NULL; + char *c_link_name = NULL; + int ret_value = 0; + + /* + * Convert FORTRAN name to C name + */ + if((c_obj_name = HD5f2cstring(obj_name, (size_t)*obj_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lcreate_hard function. + */ + if ( H5Lcreate_hard((hid_t)*obj_loc_id, c_obj_name, (hid_t)*link_loc_id, c_link_name, (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_obj_name) + HDfree(c_obj_name); + if(c_link_name) + HDfree(c_link_name); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5ldelete_by_idx_c + * Purpose: Calls h5ldelete_by_idx + * Inputs: + * loc_id - File or group identifier specifying location of subject group + * group_name - Name of subject group + * group_namelen - Name length + * index_field - Type of index; Possible values are: + * H5_INDEX_UNKNOWN_F = -1 - Unknown index type + * H5_INDEX_NAME_F - Index on names + * H5_INDEX_CRT_ORDER_F - Index on creation order + * H5_INDEX_N_F - Number of indices defined + * order - Order within field or index; Possible values are: + * H5_ITER_UNKNOWN_F - Unknown order + * H5_ITER_INC_F - Increasing order + * H5_ITER_DEC_F - Decreasing order + * H5_ITER_NATIVE_F - No particular order, whatever is fastest + * H5_ITER_N_F - Number of iteration orders + * n - Link for which to retrieve information + * lapl_id - Link access property list + * + * Outputs: N/A + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 29, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5ldelete_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, size_t_f *n, hid_t_f *lapl_id) +{ + char *c_group_name = NULL; /* Buffer to hold C string */ + H5_index_t c_index_field; + H5_iter_order_t c_order; + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_index_field = (H5_index_t)*index_field; + c_order = (H5_iter_order_t)*order; + + /* + * Call H5Ldelete_by_name function. + */ + if(H5Ldelete_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_group_name) + HDfree(c_group_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lexists_c + * Purpose: Calls H5Lexists + * Inputs: + * loc_id - Identifier of the file or group to query. + * name - Link name to check + * lapl_id - Link access property list identifier. + * Outputs: + * link_exists_c - returns a positive value, for TRUE, or 0 (zero), for FALSE. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 29, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5lexists_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *link_exists) +{ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lexists function. + */ + if((*link_exists = (hid_t_f)H5Lexists((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + +done: + if(c_name) + HDfree(c_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lget_info_c + * Purpose: Call H5Lget_info + * Inputs: + * link_loc_id - File or group identifier. + * link_name - Name of the link for which information is being sought + * link_namelen - Name length + * lapl_id - Link access property list + * Outputs: + * + * cset - indicates the character set used for link’s name. + * corder - specifies the link’s creation order position. + * corder_valid - indicates whether the value in corder is valid. + * link_type - specifies the link class: + * H5L_LINK_HARD_F - Hard link + * H5L_LINK_SOFT_F - Soft link + * H5L_LINK_EXTERNAL_F - External link + * H5L_LINK_ERROR_F - Error + * address - If the link is a hard link, address specifies the file address that the link points to + * val_size - If the link is a symbolic link, val_size will be the length of the link value + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lget_info_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, + int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, + int_f *address, hsize_t_f *val_size, + hid_t_f *lapl_id) +{ + char *c_link_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + H5L_info_t link_buff; + + /* + * Convert FORTRAN name to C name + */ + if((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) + HGOTO_DONE(FAIL); + /* + * Call H5Linfo function. + */ + if(H5Lget_info((hid_t)*link_loc_id, c_link_name, &link_buff, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *cset = (int_f)link_buff.cset; + *corder = (int_f)link_buff.corder; + *corder_valid = 0; + if(link_buff.corder_valid > 0) *corder_valid = 1; + *link_type = (int_f)link_buff.type; + *address = (int_f)link_buff.u.address; + *val_size = (hsize_t)link_buff.u.val_size; + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lget_info_by_idx_c + * Purpose: Call H5Lget_info_by_idx + * Inputs: + * loc_id - File or group identifier specifying location of subject group + * group_name - Name of subject group + *group_namelen - Name length + * index_field - Index or field which determines the order + * order - Order within field or index + * n - Link for which to retrieve information + * lapl_id - Link access property list + * Outputs: + * corder_valid - Indicates whether the the creation order data is valid for this attribute + * corder - Is a positive integer containing the creation order of the attribute + * cset - Indicates the character set used for the attribute’s name + * data_size - indicates the size, in the number of characters, of the attribute + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, hsize_t_f *n, + int_f *corder_valid, int_f *corder, int_f *cset, hsize_t_f *data_size, hid_t_f *lapl_id) +{ + char *c_group_name = NULL; /* Buffer to hold C string */ + H5_index_t c_index_field; + H5_iter_order_t c_order; + int_f ret_value = 0; /* Return value */ + H5L_info_t link_buff; + + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_index_field = (H5_index_t)*index_field; + c_order = (H5_iter_order_t)*order; + /* + * Call H5Linfo_by_idx function. + */ + if(H5Lget_info_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n, + &link_buff, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + /* Unpack the structure */ + + *corder_valid = 0; + if(link_buff.corder_valid > 0) *corder_valid = 1; + + *corder = (int_f)link_buff.corder; + *cset = (int_f)link_buff.cset; + *data_size = (hsize_t)link_buff.u.val_size; + +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: H5Lis_registered_c + * Purpose: Call H5Lis_registered + * Inputs: + * link_cls_id - User-defined link class identifier + * Outputs: NONE + * + * Returns: Returns a positive value if the link class has been registered + * and zero if it is unregistered. Otherwise returns a negative value + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lis_registered_c(int_f *link_cls_id) +{ + int_f ret_value = 0; /* Return value */ + H5L_type_t c_link_cls_id; /* User-defined link class identifier */ + htri_t registered; /* registration status */ + + + c_link_cls_id = (H5L_type_t)*link_cls_id; + /* + * Call H5Lis_registered + */ + registered = H5Lis_registered(c_link_cls_id); + + ret_value = (int_f)registered; + + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5lmove_c + * Purpose: Call H5Lmove + * Inputs: + * src_loc_id - Original file or group identifier. + * src_name - Original link name. + * src_namelen - name length + * dest_loc_id - Destination file or group identifier. + * dest_name - NEW link name. + * dest_namelen - name length + * Outputs: + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lmove_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, + _fcd dest_name, size_t_f *dest_namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id) + +{ + char *c_src_name = NULL; /* Buffer to hold C string */ + char *c_dest_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_src_name = HD5f2cstring(src_name, (size_t)*src_namelen)) == NULL) + HGOTO_DONE(FAIL); + if((c_dest_name = HD5f2cstring(dest_name, (size_t)*dest_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lmove function. + */ + if(H5Lmove((hid_t)*src_loc_id, c_src_name, (hid_t)*dest_loc_id, + c_dest_name, (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); +done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lget_name_by_idx_c + * Purpose: Call H5Lget_name_by_idx + * Inputs: + * loc_id - File or group identifier specifying location of subject group + * group_name - Name of subject group + * index_field - Index or field which determines the order + * order - Order within field or index + * n - Link for which to retrieve information + * size - Maximum number of characters of link value to be returned. + * lapl_id - Link access property list + * Outputs: + * name - Buffer in which link value is returned + * size - The size of the link name on success + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 10, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lget_name_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, hsize_t_f *n, + size_t_f *size, _fcd name, hid_t_f *lapl_id) +{ + char *c_group_name = NULL; /* Buffer to hold C string */ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + size_t c_size; + + /* + * Convert FORTRAN name to C name + */ + if((c_group_name = HD5f2cstring(group_name, (size_t)*group_namelen)) == NULL) + HGOTO_DONE(FAIL); + + c_size = (size_t)*size + 1; + /* + * Allocate buffer to hold name of an attribute + */ + if ((c_name = HDmalloc(c_size)) == NULL) + HGOTO_DONE(FAIL); + + if((*size = (size_t)H5Lget_name_by_idx((hid_t)*loc_id, c_group_name, (H5_index_t)*index_field, + (H5_iter_order_t)*order, (hsize_t)*n,c_name, c_size, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + if(c_name != NULL) + HD5packFstring(c_name, _fcdtocp(name), c_size-1); +done: + if(c_group_name) HDfree(c_group_name); + if(c_name) HDfree(c_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5lget_val_c + * Purpose: Call H5Lget_val + * Inputs: + * link_loc_id - File or group identifier. + * link_name - Name of the link for which valrmation is being sought + * link_namelen - Name length + * size - Maximum number of characters of link value to be returned. + * lapl_id - Link access property list + * Outputs: + * linkval_buff - The buffer to hold the returned link value. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +/* int_f */ +/* nh5lget_val_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, */ +/* size_t_f *size, _fcd linkval_buff, */ +/* hid_t_f *lapl_id) */ +/* { */ +/* char *c_link_name = NULL; /\* Buffer to hold C string *\/ */ +/* int_f ret_value = 0; /\* Return value *\/ */ +/* void *c_linkval_buff = NULL; */ + +/* /\* */ +/* * Convert FORTRAN name to C name */ +/* *\/ */ +/* if((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* /\* */ +/* * Call H5Lval function. */ +/* *\/ */ +/* if(H5Lget_val((hid_t)*link_loc_id, c_link_name, &linkval_buff, (size_t)*size, (hid_t)*lapl_id) < 0) */ +/* HGOTO_DONE(FAIL); */ +/* /\* */ +/* * Convert C name to FORTRAN */ +/* *\/ */ +/* HD5packFstring(c_buf, _fcdtocp(buf), c_bufsize-1); */ + + +/* done: */ +/* return ret_value; */ +/* } */ + + +/*---------------------------------------------------------------------------- + * Name: H5Lregistered_c + * Purpose: Call H5Lregistered + * Inputs: + * + * Inputs: + * version - Version number of this struct + * class_id - Link class identifier + * comment - Comment for debugging + * comment_len - Comment for debugging + * create_func - Callback during link creation + * create_func_len - length + * move_func - Callback after moving link + * move_func_len - length + * copy_func - Callback after copying link + * copy_func_len - length + * trav_func - The main traversal function + * trav_func_len - length + * del_func - Callback for link deletion + * del_func_len - length + * query_func - Callback for queries + * query_func_len - length + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +/* int_f */ + +/* nh5lregistered_c(int_f *version, int_f *class_id, */ +/* _fcd comment, size_t_f *comment_len, */ +/* _fcd create_func, size_t_f *create_func_len, */ +/* _fcd move_func, size_t_f *move_func_len, */ +/* _fcd copy_func, size_t_f *copy_func_len, */ +/* _fcd trav_func, size_t_f *trav_func_len, */ +/* _fcd del_func , size_t_f *del_func_len, */ +/* _fcd query_func, size_t_f *query_func_len) */ +/* { */ +/* char *c_comment = NULL; */ +/* char *c_create_func = NULL; */ +/* char *c_move_func = NULL; */ +/* char *c_copy_func = NULL; */ +/* char *c_trav_func = NULL; */ +/* char *c_del_func = NULL; */ +/* char *c_query_func = NULL; */ + +/* H5L_class_t class_t; */ + +/* int ret_value = 0; */ + +/* /\* */ +/* * Convert FORTRAN name to C name */ +/* *\/ */ +/* if((c_comment = HD5f2cstring(c_comment, (size_t)*sc_comment_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_create_func = HD5f2cstring(c_create_func, (size_t)*c_create_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_move_func = HD5f2cstring(c_move_func, (size_t)*sc_move_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_copy_func = HD5f2cstring(c_copy_func, (size_t)*c_copy_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_trav_func = HD5f2cstring(c_trav_func, (size_t)*sc_trav_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_del_func = HD5f2cstring(c_del_func, (size_t)*c_del_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* if((c_query_func = HD5f2cstring(c_query_func, (size_t)*c_query_func_len)) == NULL) */ +/* HGOTO_DONE(FAIL); */ +/* /\* */ +/* * Pack into C struct H5L_class_t */ +/* *\/ */ +/* int version; /\* Version number of this struct *\/ */ +/* H5L_type_t class_id; /\* Link class identifier *\/ */ +/* const char *comment; /\* Comment for debugging *\/ */ +/* H5L_create_func_t create_func; /\* Callback during link creation *\/ */ +/* H5L_move_func_t move_func; /\* Callback after moving link *\/ */ +/* H5L_copy_func_t copy_func; /\* Callback after copying link *\/ */ +/* H5L_traverse_func_t trav_func; /\* The main traversal function *\/ */ +/* H5L_delete_func_t del_func; /\* Callback for link deletion *\/ */ +/* H5L_query_func_t query_func; /\* Callback for queries *\/ */ + +/* class_t.version = (int)*version; */ +/* class_t.class_id = (H5L_type_t)*class_id; */ +/* class_t.comment = c_comment; */ +/* class_t. */ + +/* /\* */ +/* * Call H5Lcopy function. */ +/* *\/ */ +/* if( H5Lcopy( (hid_t)*src_loc_id, c_src_name, (hid_t) *dest_loc_id, */ +/* c_dest_name, (hid_t)*lcpl_id, (hid_t)*lapl_id ) < 0) */ +/* HGOTO_DONE(FAIL); */ + +/* done: */ +/* if(c_src_name) */ +/* HDfree(c_src_name); */ +/* if(c_dest_name) */ +/* HDfree(c_dest_name); */ + +/* return ret_value; */ +/* } */ + +/*---------------------------------------------------------------------------- + * Name: h5lget_val_c + * Purpose: Call H5Lget_val_c + * Inputs: + * link_loc_id - File or group identifier. + * link_name - Link whose value is to be returned. + * link_name_len - length of link_name + * size - Maximum number of characters of link value to be returned. + * lapl_id - List access property list identifier + * Outputs: + * linkval_buff - The buffer to hold the returned link value. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 11, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ +int_f +nh5lget_val_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, size_t_f *size, + void *linkval_buff, hid_t_f *lapl_id) +{ + int_f ret_value = 0; /* Return value */ + char *c_link_name = NULL; /* Buffer to hold C string */ + + /* + * Convert FORTRAN name to C name + */ + if((c_link_name = HD5f2cstring(link_name, (size_t)*link_namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Lget_val + */ + + if(H5Lget_val( (hid_t)*link_loc_id, c_link_name, &linkval_buff, (size_t)*size, (hid_t)*lapl_id )< 0) + HGOTO_DONE(FAIL); + +done: + return ret_value; +} + + diff --git a/fortran/src/H5Lff.f90 b/fortran/src/H5Lff.f90 new file mode 100644 index 0000000..acb7c73 --- /dev/null +++ b/fortran/src/H5Lff.f90 @@ -0,0 +1,1323 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains Fortran90 interfaces for H5L functions. +! +MODULE H5L + + USE H5GLOBAL + +CONTAINS + +!---------------------------------------------------------------------- +! Name: h5lcopy_f +! +! Purpose: Copies a link from one location to another. +! +! Inputs: +! src_loc_id - Location identifier of the source link +! src_name - Name of the link to be copied +! dest_loc_id - Location identifier specifying the destination of the copy +! dest_name - Name to be assigned to the NEW copy +! loc_id - Identifier of the file or group containing the object +! name - Name of the link to delete +! +! Outputs: +! hdferr - error code: +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier +! lapl_id - Link access property list identifier +! +! Programmer: M.S. Breitenfeld +! February 27, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5lcopy_f(src_loc_id, src_name, dest_loc_id, dest_name, hdferr, & + lcpl_id, lapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lcopy +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: src_loc_id ! Location identifier of the source link + CHARACTER(LEN=*), INTENT(IN) :: src_name ! Name of the link to be copied + INTEGER(HID_T), INTENT(IN) :: dest_loc_id ! Location identifier specifying the destination of the copy + CHARACTER(LEN=*), INTENT(IN) :: dest_name ! Name to be assigned to the NEW copy + + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: src_namelen + INTEGER(SIZE_T) :: dest_namelen + + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lcopy_c(src_loc_id, src_name, src_namelen, dest_loc_id, dest_name, dest_namelen, & + lcpl_id_default, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LCOPY_C'::h5lcopy_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: src_loc_id + CHARACTER(LEN=*), INTENT(IN) :: src_name + INTEGER(HID_T), INTENT(IN) :: dest_loc_id + CHARACTER(LEN=*), INTENT(IN) :: dest_name + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: src_namelen + INTEGER(SIZE_T) :: dest_namelen + END FUNCTION h5lcopy_c + END INTERFACE + + src_namelen = LEN(src_name) + dest_namelen = LEN(dest_name) + + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lcopy_c(src_loc_id, src_name, src_namelen, dest_loc_id, dest_name, dest_namelen, & + lcpl_id_default, lapl_id_default) + + END SUBROUTINE h5lcopy_f + +!---------------------------------------------------------------------- +! Name: h5ldelete_f +! +! Purpose: Removes a link from a group. +! +! Inputs: +! loc_id - Identifier of the file or group containing the object +! name - Name of the link to delete +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list identifier +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5ldelete_f(loc_id, name, hdferr, lapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5ldelete_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier of the file or group containing the object + CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the link to delete + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: namelen + + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5ldelete_c(loc_id, name, namelen, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LDELETE_C'::h5ldelete_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: namelen + END FUNCTION h5ldelete_c + END INTERFACE + + namelen = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5ldelete_c(loc_id, name, namelen, lapl_id_default) + + END SUBROUTINE h5ldelete_f + +!---------------------------------------------------------------------- +! Name: H5Lcreate_soft_f +! +! Purpose: Creates a soft link to an object. +! +! Inputs: +! target_path - Path to the target object, which is not required to exist. +! link_loc_id - The file or group identifier for the new link. +! link_name - The name of the new link. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier. +! lapl_id - Link access property list identifier. +! +! Programmer: M.S. Breitenfeld +! February 20, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5lcreate_soft_f(target_path, link_loc_id, link_name, hdferr, lcpl_id, lapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lcreate_soft_f +!DEC$endif +! + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: target_path ! Path to the target object, which is not required to exist. + INTEGER(HID_T), INTENT(IN) :: link_loc_id ! The file or group identifier for the new link. + CHARACTER(LEN=*), INTENT(IN) :: link_name ! The name of the new link. + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier. + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: target_path_len + INTEGER(SIZE_T) :: link_name_len + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lcreate_soft_c(target_path, target_path_len, & + link_loc_id, & + link_name,link_name_len, & + lcpl_id_default, lapl_id_default ) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LCREATE_SOFT_C'::h5lcreate_soft_c + !DEC$ ENDIF + CHARACTER(LEN=*), INTENT(IN) :: target_path + INTEGER(SIZE_T) :: target_path_len + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER(SIZE_T) :: link_name_len + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + END FUNCTION h5lcreate_soft_c + END INTERFACE + + target_path_len = LEN(target_path) + link_name_len = LEN(link_name) + + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lcreate_soft_c(target_path, target_path_len,& + link_loc_id, & + link_name, link_name_len, & + lcpl_id_default, lapl_id_default ) + + END SUBROUTINE h5lcreate_soft_f + +!---------------------------------------------------------------------- +! Name: H5Lcreate_hard_f +! +! Purpose: Creates a hard link to an object. +! +! Inputs: +! +! obj_loc_id - The file or group identifier for the target object. +! obj_name - Name of the target object, which must already exist. +! link_loc_id - The file or group identifier for the new link. +! link_name - The name of the new link. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier. +! lapl_id - Link access property list identifier. +! +! Programmer: M.S. Breitenfeld +! February 27, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5lcreate_hard_f(obj_loc_id, obj_name, link_loc_id, link_name, hdferr, lcpl_id, lapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lcreate_hard_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_loc_id ! The file or group identifier for the target object. + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of the target object, which must already exist. + INTEGER(HID_T), INTENT(IN) :: link_loc_id ! The file or group identifier for the new link. + CHARACTER(LEN=*), INTENT(IN) :: link_name ! The name of the new link. + + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier. + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: link_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lcreate_hard_c(obj_loc_id, obj_name, obj_namelen, & + link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LCREATE_HARD_C'::h5lcreate_hard_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_loc_id + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: link_namelen + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + END FUNCTION h5lcreate_hard_c + END INTERFACE + obj_namelen = LEN(obj_name) + link_namelen = LEN(link_name) + + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lcreate_hard_c(obj_loc_id, obj_name, obj_namelen, & + link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) + + END SUBROUTINE h5lcreate_hard_f + +!---------------------------------------------------------------------- +! Name: H5Lcreate_external_f +! +! Purpose: Creates a soft link to an object in a different file. +! +! Inputs: +! +! file_name - Name of the file containing the target object. Neither the file nor the target object is +! required to exist. May be the file the link is being created in. +! obj_name - Path within the target file to the target object. +! link_loc_id - The file or group identifier for the new link. +! link_name - The name of the new link. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier. +! lapl_id - Link access property list identifier. +! +! Programmer: M.S. Breitenfeld +! February 27, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + SUBROUTINE h5lcreate_external_f(file_name, obj_name, link_loc_id, link_name, hdferr, lcpl_id, lapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lcreate_external_f +!DEC$endif +! + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: file_name ! Name of the file containing the target object. Neither + ! the file nor the target object is required to exist. + ! May be the file the link is being created in. + CHARACTER(LEN=*), INTENT(IN) :: obj_name ! Name of the target object, which must already exist. + INTEGER(HID_T), INTENT(IN) :: link_loc_id ! The file or group identifier for the new link. + CHARACTER(LEN=*), INTENT(IN) :: link_name ! The name of the new link. + + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier. + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: file_namelen + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: link_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lcreate_external_c(file_name, file_namelen, obj_name, obj_namelen, & + link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LCREATE_EXTERNAL_C'::h5lcreate_external_c + !DEC$ ENDIF + CHARACTER(LEN=*), INTENT(IN) :: file_name + CHARACTER(LEN=*), INTENT(IN) :: obj_name + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER(SIZE_T) :: file_namelen + INTEGER(SIZE_T) :: obj_namelen + INTEGER(SIZE_T) :: link_namelen + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + END FUNCTION h5lcreate_external_c + END INTERFACE + file_namelen = LEN(file_name) + obj_namelen = LEN(obj_name) + link_namelen = LEN(link_name) + + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lcreate_external_c(file_name, file_namelen, obj_name, obj_namelen, & + link_loc_id, link_name, link_namelen, lcpl_id_default, lapl_id_default) + + END SUBROUTINE h5lcreate_external_f + +!---------------------------------------------------------------------- +! Name: h5ldelete_by_idx_f +! +! Purpose: Removes the nth link in a group. +! Inputs: +! loc_id - File or group identifier specifying location of subject group +! group_name - Name of subject group +! index_field - Type of index; Possible values are: +! +! H5_INDEX_UNKNOWN_F = -1 - Unknown index type +! H5_INDEX_NAME_F - Index on names +! H5_INDEX_CRT_ORDER_F - Index on creation order +! H5_INDEX_N_F - Number of indices defined +! +! order - Order within field or index; Possible values are: +! +! H5_ITER_UNKNOWN_F - Unknown order +! H5_ITER_INC_F - Increasing order +! H5_ITER_DEC_F - Decreasing order +! H5_ITER_NATIVE_F - No particular order, whatever is fastest +! H5_ITER_N_F - Number of iteration orders +! +! n - Link for which to retrieve information +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M.S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5ldelete_by_idx_f(loc_id, group_name, index_field, order, n, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5ldelete_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifer for object to which attribute is attached + CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of object, relative to location, + ! from which attribute is to be removed + INTEGER, INTENT(IN) :: index_field ! Type of index; Possible values are: + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + ! H5_ITER_N_F - Number of iteration orders + INTEGER(HSIZE_T), INTENT(IN) :: n ! Offset within index + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: group_namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5ldelete_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LDELETE_BY_IDX_C'::h5ldelete_by_idx_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER, INTENT(IN) :: index_field + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: group_namelen + END FUNCTION h5ldelete_by_idx_c + END INTERFACE + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + group_namelen = LEN(group_name) + hdferr = h5ldelete_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, lapl_id_default) + + END SUBROUTINE h5ldelete_by_idx_f + +!---------------------------------------------------------------------- +! Name: H5Lexists_f +! +! Purpose: Check if a link with a particular name exists in a group. +! +! Inputs: +! loc_id - Identifier of the file or group to query. +! name - Link name to check +! +! Outputs: +! link_exists - link exists status (.TRUE.,.FALSE.) +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list identifier. +! +! Programmer: M. S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5lexists_f(loc_id, name, link_exists, hdferr, lapl_id) + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lexists_f +!DEC$endif + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier of the file or group to query. + CHARACTER(LEN=*), INTENT(IN) :: name ! Link name to check. + LOGICAL, INTENT(OUT) :: link_exists ! .TRUE. if exists, .FALSE. otherwise + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id + ! Link access property list identifier. + INTEGER :: link_exists_c + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: namelen +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lexists_c(loc_id, name, namelen, lapl_id_default, link_exists_c) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LEXISTS_C'::h5lexists_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(SIZE_T), INTENT(IN) :: namelen + INTEGER(HID_T), INTENT(OUT) :: link_exists_c + INTEGER(HID_T) :: lapl_id_default + + END FUNCTION h5lexists_c + END INTERFACE + + namelen = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lexists_c(loc_id, name, namelen, lapl_id_default, link_exists_c) + + link_exists = .FALSE. + IF(link_exists_c.GT.0) link_exists = .TRUE. + + END SUBROUTINE h5lexists_f + +!---------------------------------------------------------------------- +! Name: h5lget_info_f +! +! Purpose: Returns information about a link. +! +! Inputs: +! link_loc_id - File or group identifier. +! link_name - Name of the link for which information is being sought +! +! Outputs: NOTE: In C these are contained in the structure H5L_info_t +! +! cset - indicates the character set used for link’s name. +! corder - specifies the link’s creation order position. +!corder_valid - indicates whether the value in corder is valid. +! link_type - specifies the link class: +! H5L_LINK_HARD_F - Hard link +! H5L_LINK_SOFT_F - Soft link +! H5L_LINK_EXTERNAL_F - External link +! H5L_LINK_ERROR_ F - Error +! address - If the link is a hard link, address specifies the file address that the link points to +! val_size - If the link is a symbolic link, val_size will be the length of the link value +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M. S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5lget_info_f(link_loc_id, link_name, & + cset, corder, f_corder_valid, link_type, address, val_size, & + hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lget_info_f +!DEC$endif + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: link_loc_id ! File or group identifier. + CHARACTER(LEN=*), INTENT(IN) :: link_name ! Name of the link for which information is being sought + +! Outputs: NOTE: In C these are contained in the structure H5L_info_t + INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the link’s name. + INTEGER, INTENT(OUT) :: corder ! Specifies the link’s creation order position. + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the value in corder is valid. + INTEGER, INTENT(OUT) :: link_type ! Specifies the link class: + ! H5L_LINK_HARD_F - Hard link + ! H5L_LINK_SOFT_F - Soft link + ! H5L_LINK_EXTERNAL_F - External link + ! H5L_LINK_ERROR _F - Error + INTEGER, INTENT(OUT) :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(HSIZE_T), INTENT(OUT) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + + INTEGER(SIZE_T) :: link_namelen + INTEGER(HID_T) :: lapl_id_default + INTEGER :: corder_valid + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lget_info_c(link_loc_id, link_name, link_namelen, & + cset, corder, corder_valid, link_type, address, val_size, & + lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LGET_INFO_C'::h5lget_info_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: link_loc_id + CHARACTER(LEN=*), INTENT(IN) :: link_name + INTEGER, INTENT(OUT) :: cset + INTEGER, INTENT(OUT) :: corder + INTEGER, INTENT(OUT) :: link_type + INTEGER, INTENT(OUT) :: address + INTEGER(HSIZE_T), INTENT(OUT) :: val_size + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: link_namelen + INTEGER :: corder_valid + END FUNCTION h5lget_info_c + END INTERFACE + + link_namelen = LEN(link_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lget_info_c(link_loc_id, link_name, link_namelen, & + cset, corder, corder_valid, link_type, & + address, val_size, & + lapl_id_default) + + f_corder_valid =.FALSE. + IF(corder_valid .EQ. 1) f_corder_valid =.TRUE. + + END SUBROUTINE h5lget_info_f + +!---------------------------------------------------------------------- +! Name: h5lget_info_by_idx_f +! +! Purpose: Retrieves metadata for a link in a group, according to the order within a field or index. +! +! Inputs: +! loc_id - File or group identifier specifying location of subject group +! group_name - Name of subject group +! index_field - Index or field which determines the order +! order - Order within field or index +! n - Link for which to retrieve information +! +! Outputs: NOTE: In C these are defined as a structure: H5L_info_t +! corder_valid - indicates whether the creation order data is valid for this attribute +! corder - is a positive integer containing the creation order of the attribute +! cset - indicates the character set used for the attribute’s name +! data_size - indicates the size, in the number of characters, of the attribute +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Link access property list +! +! Programmer: M.S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5lget_info_by_idx_f(loc_id, group_name, index_field, order, n, & + f_corder_valid, corder, cset, data_size, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lget_info_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group + CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of subject group + INTEGER, INTENT(IN) :: index_field ! Index or field which determines the order + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER :: corder_valid + INTEGER(SIZE_T) :: group_namelen + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & + corder_valid, corder, cset, data_size, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LGET_INFO_BY_IDX_C'::h5lget_info_by_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(SIZE_T) :: group_namelen + INTEGER, INTENT(IN) :: index_field + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER :: corder_valid + INTEGER, INTENT(OUT) :: corder + INTEGER, INTENT(OUT) :: cset + INTEGER(HSIZE_T), INTENT(OUT) :: data_size + INTEGER(HID_T) :: lapl_id_default + END FUNCTION h5lget_info_by_idx_c + END INTERFACE + + group_namelen = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & + corder_valid, corder, cset, data_size, lapl_id_default) + + f_corder_valid =.FALSE. + IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. + + END SUBROUTINE h5lget_info_by_idx_f + +!---------------------------------------------------------------------- +! Name: H5Lis_registered_f +! +! Purpose: Determines whether a class of user-defined links is registered. +! +! Inputs: +! link_cls_id - User-defined link class identifier +! +! Outputs: +! registered - .TRUE. - if the link class has been registered +! .FALSE. - if it is unregistered +! hdferr - Error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! None +! +! Programmer: M.S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE H5Lis_registered_f(link_cls_id, registered, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: H5Lis_registered_f +!DEC$endif + IMPLICIT NONE + INTEGER, INTENT(IN) :: link_cls_id ! User-defined link class identifier + LOGICAL, INTENT(OUT) :: registered ! .TRUE. - if the link class has been registered and + ! .FALSE. - if it is unregistered + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Lis_registered_c(link_cls_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LIS_REGISTERED_C'::h5lis_registered_c + !DEC$ ENDIF + INTEGER, INTENT(IN) :: link_cls_id ! User-defined link class identifier + END FUNCTION H5Lis_registered_c + END INTERFACE + + hdferr = H5Lis_registered_c(link_cls_id) + + IF(hdferr.GT.0)THEN + registered = .TRUE. + ELSE IF(hdferr.EQ.0)THEN + registered = .FALSE. + ENDIF + + END SUBROUTINE H5Lis_registered_f + +!---------------------------------------------------------------------- +! Name: H5Lmove_f +! +! Purpose: Renames a link within an HDF5 file. +! +! Inputs: +! src_loc_id - Original file or group identifier. +! src_name - Original link name. +! dest_loc_id - Destination file or group identifier. +! dest_name - NEW link name. +! +! Outputs: +! hdferr - Error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier to be associated WITH the NEW link. +! lapl_id - Link access property list identifier to be associated WITH the NEW link. +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5lmove_f(src_loc_id, src_name, dest_loc_id, dest_name, hdferr, lcpl_id, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: H5Lmove_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: src_loc_id ! Original file or group identifier. + CHARACTER(LEN=*), INTENT(IN) :: src_name ! Original link name. + INTEGER(HID_T), INTENT(IN) :: dest_loc_id ! Destination file or group identifier. + CHARACTER(LEN=*), INTENT(IN) :: dest_name ! NEW link name. + INTEGER(HID_T), INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier + ! to be associated WITH the NEW link. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list identifier + ! to be associated WITH the NEW link. + + INTEGER(SIZE_T) :: src_namelen + INTEGER(SIZE_T) :: dest_namelen + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Lmove_c(src_loc_id, src_name, src_namelen, dest_loc_id, & + dest_name, dest_namelen, lcpl_id_default, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LMOVE_C'::h5lmove_c + !DEC$ ENDIF + + INTEGER(HID_T), INTENT(IN) :: src_loc_id + CHARACTER(LEN=*), INTENT(IN) :: src_name + INTEGER(SIZE_T) :: src_namelen + INTEGER(HID_T), INTENT(IN) :: dest_loc_id + CHARACTER(LEN=*), INTENT(IN) :: dest_name + INTEGER(SIZE_T) :: dest_namelen + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: lapl_id_default + + END FUNCTION H5Lmove_c + END INTERFACE + + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + src_namelen = LEN(src_name) + dest_namelen = LEN(dest_name) + + hdferr = H5Lmove_c(src_loc_id, src_name, src_namelen, dest_loc_id, & + dest_name, dest_namelen, lcpl_id_default, lapl_id_default) + + END SUBROUTINE H5Lmove_f + +!---------------------------------------------------------------------- +! Name: h5lget_name_by_idx_f +! +! Purpose: Retrieves name of the nth link in a group, according to the order within a specified field or index. +! +! Inputs: +! loc_id - File or group identifier specifying location of subject group +! group_name - Name of subject group +! index_field - Index or field which determines the order +! order - Order within field or index +! n - Link for which to retrieve information +! +! Outputs: +! name - Buffer in which link value is returned +! size - Maximum number of characters of link value to be returned. +! hdferr - error code +! Success: 0 +! Failure: -1 +! +! Optional parameters: +! lapl_id - List access property list identifier. +! +! Programmer: M. S. Breitenfeld +! March 10, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + SUBROUTINE h5lget_name_by_idx_f(loc_id, group_name, index_field, order, n, & + size, name, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5lget_name_by_idx_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group + CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of subject group + INTEGER, INTENT(IN) :: index_field ! Index or field which determines the order + ! H5_INDEX_UNKNOWN_F - Unknown index type + ! H5_INDEX_NAME_F - Index on names + ! H5_INDEX_CRT_ORDER_F - Index on creation order + ! H5_INDEX_N_F - Number of indices defined + INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: + ! H5_ITER_UNKNOWN_F - Unknown order + ! H5_ITER_INC_F - Increasing order + ! H5_ITER_DEC_F - Decreasing order + ! H5_ITER_NATIVE_F - No particular order, whatever is fastest + INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index + INTEGER(SIZE_T), INTENT(INOUT) :: size ! Indicates the size, in the number of characters, of the attribute + ! returns correct size + CHARACTER(LEN=*), INTENT(OUT) :: name ! Buffer in which link value is returned + INTEGER, INTENT(OUT) :: hdferr ! Error code: + + INTEGER(SIZE_T) :: group_namelen + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list + INTEGER(HID_T) :: lapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5lget_name_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & + size, name, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LGET_NAME_BY_IDX_C'::h5lget_name_by_idx_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: group_name + INTEGER(SIZE_T) :: group_namelen + INTEGER, INTENT(IN) :: index_field + INTEGER, INTENT(IN) :: order + INTEGER(HSIZE_T), INTENT(IN) :: n + INTEGER(SIZE_T), INTENT(INOUT) :: size + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER(HID_T) :: lapl_id_default + END FUNCTION h5lget_name_by_idx_c + END INTERFACE + + group_namelen = LEN(group_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5lget_name_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & + size, name, lapl_id_default) + + END SUBROUTINE h5lget_name_by_idx_f + + +! HAS PROBLEM WITH void pointer in C + +!!$!---------------------------------------------------------------------- +!!$! Name: h5lget_val_by_idx_f +!!$! +!!$! Purpose: Returns the link value of a link, according to the order of +!!$! an index. For symbolic links, this is the path to which the +!!$! link points, including the null terminator. For user-defined +!!$! links, it is the link buffer. +!!$! Inputs: +!!$! loc_id - File or group identifier specifying location of subject group +!!$! group_name - Name of subject group +!!$! index_field - Index or field which determines the order +!!$! order - Order within field or index +!!$! n - Link for which to retrieve information +!!$! size - Maximum number of characters of link value to be returned. +!!$! +!!$! Outputs: NOTE: In C these are defined as a structure: H5L_info_t +!!$! corder_valid - indicates whether the creation order data is valid for this attribute +!!$! corder - is a positive integer containing the creation order of the attribute +!!$! cset - indicates the character set used for the attribute’s name +!!$! data_size - indicates the size, in the number of characters, of the attribute +!!$! hdferr - error code +!!$! Success: 0 +!!$! Failure: -1 +!!$! Optional parameters: +!!$! lapl_id - List access property list identifier. +!!$! +!!$! Programmer: M. S. Breitenfeld +!!$! March 3, 2008 +!!$! +!!$! Modifications: N/A +!!$! +!!$!---------------------------------------------------------------------- +!!$ SUBROUTINE h5lget_val_by_idx_f(loc_id, group_name, index_field, order, n, & +!!$ f_corder_valid, corder, cset, data_size, hdferr, lapl_id) +!!$!This definition is needed for Windows DLLs +!!$!DEC$if defined(BUILD_HDF5_DLL) +!!$!DEC$attributes dllexport :: h5lget_val_by_idx_f +!!$!DEC$endif +!!$ IMPLICIT NONE +!!$ INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier specifying location of subject group +!!$ CHARACTER(LEN=*), INTENT(IN) :: group_name ! Name of subject group +!!$ INTEGER, INTENT(IN) :: index_field ! Index or field which determines the order +!!$ ! H5_INDEX_UNKNOWN_F - Unknown index type +!!$ ! H5_INDEX_NAME_F - Index on names +!!$ ! H5_INDEX_CRT_ORDER_F - Index on creation order +!!$ ! H5_INDEX_N_F - Number of indices defined +!!$ INTEGER, INTENT(IN) :: order ! Order in which to iterate over index; Possible values are: +!!$ ! H5_ITER_UNKNOWN_F - Unknown order +!!$ ! H5_ITER_INC_F - Increasing order +!!$ ! H5_ITER_DEC_F - Decreasing order +!!$ ! H5_ITER_NATIVE_F - No particular order, whatever is fastest +!!$ INTEGER(HSIZE_T), INTENT(IN) :: n ! Attribute’s position in index +!!$ LOGICAL, INTENT(OUT) :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute +!!$ INTEGER, INTENT(OUT) :: corder ! Is a positive integer containing the creation order of the attribute +!!$ INTEGER, INTENT(OUT) :: cset ! Indicates the character set used for the attribute’s name +!!$ INTEGER(HSIZE_T), INTENT(OUT) :: data_size ! Indicates the size, in the number of characters, of the attribute +!!$ INTEGER, INTENT(OUT) :: hdferr ! Error code: +!!$ ! 0 on success and -1 on failure +!!$ INTEGER :: corder_valid +!!$ INTEGER(SIZE_T) :: group_namelen +!!$ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list +!!$ INTEGER(HID_T) :: lapl_id_default +!!$ +!!$! MS FORTRAN needs explicit interface for C functions called here. +!!$! +!!$ INTERFACE +!!$ INTEGER FUNCTION h5lget_val_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & +!!$ corder_valid, corder, cset, data_size, lapl_id_default) +!!$ USE H5GLOBAL +!!$ !DEC$ IF DEFINED(HDF5F90_WINDOWS) +!!$ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LGET_VAL_BY_IDX_C'::h5lget_val_by_idx_c +!!$ !DEC$ ENDIF +!!$ INTEGER(HID_T), INTENT(IN) :: loc_id +!!$ CHARACTER(LEN=*), INTENT(IN) :: group_name +!!$ INTEGER(SIZE_T) :: group_namelen +!!$ INTEGER, INTENT(IN) :: index_field +!!$ INTEGER, INTENT(IN) :: order +!!$ INTEGER(HSIZE_T), INTENT(IN) :: n +!!$ INTEGER :: corder_valid +!!$ INTEGER, INTENT(OUT) :: corder +!!$ INTEGER, INTENT(OUT) :: cset +!!$ INTEGER(HSIZE_T), INTENT(OUT) :: data_size +!!$ INTEGER(HID_T) :: lapl_id_default +!!$ END FUNCTION h5lget_val_by_idx_c +!!$ END INTERFACE +!!$ +!!$ group_namelen = LEN(group_name) +!!$ +!!$ lapl_id_default = H5P_DEFAULT_F +!!$ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id +!!$ +!!$ hdferr = h5lget_info_by_idx_c(loc_id, group_name, group_namelen, index_field, order, n, & +!!$ corder_valid, corder, cset, data_size, lapl_id_default) +!!$ +!!$ f_corder_valid =.FALSE. +!!$ IF (corder_valid .EQ. 1) f_corder_valid =.TRUE. +!!$ +!!$ END SUBROUTINE h5lget_val_by_idx_f + + + +!---------------------------------------------------------------------- +! Name: h5lget_val_f +! +! Purpose: Returns the value of a symbolic link. +! +! Inputs: +! link_loc_id - File or group identifier. +! link_name - Link whose value is to be returned. +! size - Maximum number of characters of link value to be returned. +! +! Outputs: +! linkval_buff - The buffer to hold the returned link value. +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - List access property list identifier. +! +! Programmer: M. S. Breitenfeld +! March 3, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + +!!$ SUBROUTINE h5lget_val_f(link_loc_id, link_name, size, linkval_buff, & +!!$ hdferr, lapl_id) +!!$!This definition is needed for Windows DLLs +!!$!DEC$if defined(BUILD_HDF5_DLL) +!!$!DEC$attributes dllexport :: h5lget_val_f +!!$!DEC$endif +!!$ IMPLICIT NONE +!!$ INTEGER(HID_T), INTENT(IN) :: link_loc_id ! File or group identifier. +!!$ CHARACTER(LEN=*), INTENT(IN) :: link_name ! Link whose value is to be returned. +!!$ INTEGER(SIZE_T), INTENT(IN) :: size ! Maximum number of characters of link value to be returned. +!!$ +!!$ CHARACTER(LEN=size), INTENT(OUT) :: linkval_buff ! The buffer to hold the returned link value. +!!$ INTEGER, INTENT(OUT) :: hdferr ! Error code: +!!$ ! 0 on success and -1 on failure +!!$ INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link access property list +!!$ +!!$ INTEGER :: link_namelen +!!$ INTEGER(HID_T) :: lapl_id_default +!!$ INTEGER :: corder_valid +!!$ +!!$ INTEGER :: link_namelen +!!$ INTEGER(HID_T) :: lapl_id_default +!!$ +!!$! MS FORTRAN needs explicit interface for C functions called here. +!!$! +!!$ INTERFACE +!!$ INTEGER FUNCTION h5lget_val_c(link_loc_id, link_name, link_namelen, size, linkval_buff, & +!!$ lapl_id_default) +!!$ USE H5GLOBAL +!!$ !DEC$ IF DEFINED(HDF5F90_WINDOWS) +!!$ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LGET_VAL_C'::h5lget_val_c +!!$ !DEC$ ENDIF +!!$ INTEGER(HID_T), INTENT(IN) :: link_loc_id ! File or group identifier. +!!$ CHARACTER(LEN=*), INTENT(IN) :: link_name ! Link whose value is to be returned. +!!$ INTEGER :: link_namelen +!!$ INTEGER(SIZE_T), INTENT(IN) :: size ! Maximum number of characters of link value to be returned. +!!$ +!!$ CHARACTER(LEN=size), INTENT(OUT) :: linkval_buff ! The buffer to hold the returned link value. +!!$ +!!$ INTEGER :: link_namelen +!!$ INTEGER(HID_T) :: lapl_id_default +!!$ +!!$ END FUNCTION h5lget_val_c +!!$ END INTERFACE +!!$ +!!$ link_namelen = LEN(link_name) +!!$ +!!$ lapl_id_default = H5P_DEFAULT_F +!!$ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id +!!$ +!!$ hdferr = h5lget_val_c(link_loc_id, link_name, link_namelen, size, linkval_buff, & +!!$ lapl_id_default) +!!$ +!!$ END SUBROUTINE h5lget_val_f + + + +!---------------------------------------------------------------------- +! Name: H5Lregistered_f +! +! Purpose: Registers user-defined link class or changes behavior of existing class. +! +! Inputs: NOTE: In C the following represents struct H5L_class_t: +! version - Version number of this struct +! class_id - Link class identifier +! comment - Comment for debugging +! create_func - Callback during link creation +! move_func - Callback after moving link +! copy_func - Callback after copying link +! trav_func - The main traversal function +! del_func - Callback for link deletion +! query_func - Callback for queries +! +! Outputs: +! hdferr - Error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! None +! +! Programmer: M.S. Breitenfeld +! February 29, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- +!!$ SUBROUTINE H5Lregistered_f(version, class_id, comment, create_func, & +!!$ move_func, copy_func, trav_func, del_func, query_func, hdferr) +!!$!This definition is needed for Windows DLLs +!!$!DEC$if defined(BUILD_HDF5_DLL) +!!$!DEC$attributes dllexport :: H5Lregistered_f +!!$!DEC$endif +!!$ IMPLICIT NONE +!!$ INTEGER, INTENT(IN) :: version ! Version number of this struct +!!$ INTEGER, INTENT(IN) :: class_id ! Link class identifier +!!$ CHARACTER(LEN=*), INTENT(IN) :: comment ! Comment for debugging +!!$ CHARACTER(LEN=*), INTENT(IN) :: create_func ! Callback during link creation +!!$ CHARACTER(LEN=*), INTENT(IN) :: move_func ! Callback after moving link +!!$ CHARACTER(LEN=*), INTENT(IN) :: copy_func ! Callback after copying link +!!$ CHARACTER(LEN=*), INTENT(IN) :: trav_func ! The main traversal function +!!$ CHARACTER(LEN=*), INTENT(IN) :: del_func ! Callback for link deletion +!!$ CHARACTER(LEN=*), INTENT(IN) :: query_func ! Callback for queries +!!$ INTEGER, INTENT(OUT) :: hdferr ! Error code: +!!$ ! 0 on success and -1 on failure +!!$ INTEGER :: comment_len +!!$ INTEGER :: create_func_len +!!$ INTEGER :: move_func_len +!!$ INTEGER :: copy_func_len +!!$ INTEGER :: trav_func_len +!!$ INTEGER :: del_func_len +!!$ INTEGER :: query_func_len +!!$ +!!$! +!!$! MS FORTRAN needs explicit interface for C functions called here. +!!$! +!!$ INTERFACE +!!$ INTEGER FUNCTION H5Lregistered_c(version, class_id, comment, & +!!$ create_func, create_func_len, & +!!$ move_func, move_func_len, & +!!$ copy_func, copy_func_len, & +!!$ trav_func, trav_func_len, & +!!$ del_func, del_func_len, & +!!$ query_func,query_func_len) +!!$ USE H5GLOBAL +!!$ !DEC$ IF DEFINED(HDF5F90_WINDOWS) +!!$ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5LREGISTERED_C'::H5Lregistered_c +!!$ !DEC$ ENDIF +!!$ INTEGER, INTENT(IN) :: version ! Version number of this struct +!!$ INTEGER, INTENT(IN) :: class_id ! Link class identifier +!!$ CHARACTER(LEN=*), INTENT(IN) :: comment ! Comment for debugging +!!$ CHARACTER(LEN=*), INTENT(IN) :: create_func ! Callback during link creation +!!$ CHARACTER(LEN=*), INTENT(IN) :: move_func ! Callback after moving link +!!$ CHARACTER(LEN=*), INTENT(IN) :: copy_func ! Callback after copying link +!!$ CHARACTER(LEN=*), INTENT(IN) :: trav_func ! The main traversal function +!!$ CHARACTER(LEN=*), INTENT(IN) :: del_func ! Callback for link deletion +!!$ CHARACTER(LEN=*), INTENT(IN) :: query_func ! Callback for queries +!!$ INTEGER, INTENT(OUT) :: hdferr ! Error code: +!!$ ! 0 on success and -1 on failure +!!$ INTEGER :: comment_len +!!$ INTEGER :: create_func_len +!!$ INTEGER :: move_func_len +!!$ INTEGER :: copy_func_len +!!$ INTEGER :: trav_func_len +!!$ INTEGER :: del_func_len +!!$ INTEGER :: query_func_len +!!$ +!!$ END FUNCTION H5Lregistered_c +!!$ END INTERFACE +!!$ +!!$ comment_len = LEN(comment) +!!$ create_func_len = LEN(create_func) +!!$ move_func_len = LEN(move_func) +!!$ copy_func_len = LEN(copy_func) +!!$ trav_func_len = LEN(trav_func) +!!$ del_func_len = LEN(del_func) +!!$ query_func_len = LEN(query_func) +!!$ +!!$ hdferr = H5Lregistered_c(version, class_id, comment, & +!!$ create_func, create_func_len, & +!!$ move_func, move_func_len, & +!!$ copy_func, copy_func_len, & +!!$ trav_func, trav_func_len, & +!!$ del_func, del_func_len, & +!!$ query_func, query_func_len) +!!$ +!!$ END SUBROUTINE H5Lregistered_f + +END MODULE H5L diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c new file mode 100644 index 0000000..9a708da --- /dev/null +++ b/fortran/src/H5Of.c @@ -0,0 +1,99 @@ +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * Copyright by The HDF Group. * + * Copyright by the Board of Trustees of the University of Illinois. * + * All rights reserved. * + * * + * This file is part of HDF5. The full HDF5 copyright notice, including * + * terms governing use, modification, and redistribution, is contained in * + * the files COPYING and Copyright.html. COPYING can be found at the root * + * of the source code distribution tree; Copyright.html can be found at the * + * root level of an installed copy of the electronic HDF5 document set and * + * is linked from the top-level documents page. It can also be found at * + * http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * + * access to either file, you may request a copy from help@hdfgroup.org. * + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +/* This files contains C stubs for H5O Fortran APIs */ + +#include "H5f90.h" +#include "H5Eprivate.h" + +/*---------------------------------------------------------------------------- + * Name: h5olink_c + * Purpose: Calls H5Olink + * Inputs: + * object_id - Object to be linked. + * new_loc_id - File or group identifier specifying location at which object is to be linked. + * name - Name of link to be created, relative to new_loc_id. + * namelen - Length of buffer for link to be created. + * lcpl_id - Link creation property list identifier. + * lapl_id - Link access property list identifier. + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id) +{ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if( (c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Olink function. + */ + if((hid_t_f)H5Olink((hid_t)*object_id, (hid_t)*new_loc_id, c_name, + (hid_t)*lcpl_id, (hid_t)*lapl_id) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_name) + HDfree(c_name); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5oopen_c + * Purpose: Calls H5Oopen + * Inputs: loc_id - File or group identifier + * name - Attribute access property list + * namelen - Size of name + * lapl_id - Link access property list + * Outputs: obj_id - Dataset identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 18, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id) +{ + char *c_name = NULL; /* Buffer to hold C string */ + int_f ret_value = 0; /* Return value */ + + /* + * Convert FORTRAN name to C name + */ + if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL) + HGOTO_DONE(FAIL); + + /* + * Call H5Oopen function. + */ + if((*obj_id = (hid_t_f)H5Oopen((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0) + HGOTO_DONE(FAIL); + + done: + if(c_name) + HDfree(c_name); + return ret_value; +} + diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90 new file mode 100644 index 0000000..c64b82d --- /dev/null +++ b/fortran/src/H5Off.f90 @@ -0,0 +1,163 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! This file contains Fortran90 interfaces for H5O functions. +! +MODULE H5O + + USE H5GLOBAL + +CONTAINS + +!---------------------------------------------------------------------- +! Name: h5olink_f +! +! Purpose: Creates a hard link to an object in an HDF5 file. +! +! Inputs: +! object_id - Object to be linked. +! new_loc_id - File or group identifier specifying location at which object is to be linked. +! new_link_name - Name of link to be created, relative to new_loc_id. +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lcpl_id - Link creation property list identifier. +! lapl_id - Link access property list identifier. +! +! Programmer: M.S. Breitenfeld +! April 21, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5olink_f(object_id, new_loc_id, new_link_name, hdferr, lcpl_id, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5olink_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: object_id ! Object to be linked + INTEGER(HID_T), INTENT(IN) :: new_loc_id ! File or group identifier specifying + ! location at which object is to be linked. + CHARACTER(LEN=*), INTENT(IN) :: new_link_name ! Name of link to be created, relative to new_loc_id. + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! Success: 0 + ! Failure: -1 + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list identifier. + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Link creation property list identifier. + INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T) :: lcpl_id_default + + INTEGER(SIZE_T) :: new_link_namelen + + INTERFACE + INTEGER FUNCTION h5olink_c(object_id, new_loc_id, new_link_name, new_link_namelen, & + lcpl_id_default, lapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OLINK_C'::h5olink_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: object_id + INTEGER(HID_T), INTENT(IN) :: new_loc_id + CHARACTER(LEN=*), INTENT(IN) :: new_link_name + INTEGER(SIZE_T) :: new_link_namelen + INTEGER(HID_T) :: lapl_id_default + INTEGER(HID_T) :: lcpl_id_default + END FUNCTION h5olink_c + END INTERFACE + + new_link_namelen = LEN(new_link_name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + lcpl_id_default = H5P_DEFAULT_F + IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + + hdferr = h5olink_c(object_id, new_loc_id, new_link_name, new_link_namelen, & + lcpl_id_default, lapl_id_default) + + END SUBROUTINE h5olink_f + +!---------------------------------------------------------------------- +! Name: h5oopen_f +! +! Purpose: Opens an object in an HDF5 file by location identifier and path name.O +! +! Inputs: +! loc_id - File or group identifier +! name - Path to the object, relative to loc_id. +! Outputs: +! obj_id - Object identifier for the opened object +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! lapl_id - Access property list identifier for the link pointing to the object +! +! Programmer: M.S. Breitenfeld +! April 18, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5oopen_f(loc_id, name, obj_id, hdferr, lapl_id) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5oopen_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier + CHARACTER(LEN=*), INTENT(IN) :: name ! Path to the object, relative to loc_id + INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier for the opened object + INTEGER, INTENT(OUT) :: hdferr ! Error code + ! Success: 0 + ! Failure: -1 + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lapl_id ! Attribute access property list + INTEGER(HID_T) :: lapl_id_default + + INTEGER(SIZE_T) :: namelen + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5oopen_c(loc_id, name, namelen, lapl_id_default, obj_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OOPEN_C'::h5oopen_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER(HID_T) :: lapl_id_default + INTEGER(SIZE_T) :: namelen + INTEGER(HID_T), INTENT(OUT) :: obj_id + END FUNCTION h5oopen_c + END INTERFACE + + namelen = LEN(name) + + lapl_id_default = H5P_DEFAULT_F + IF(PRESENT(lapl_id)) lapl_id_default = lapl_id + + hdferr = h5oopen_c(loc_id, name, namelen, lapl_id_default, obj_id) + + END SUBROUTINE h5oopen_f + + +END MODULE H5O diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index f674530..ea7a4bb 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -1,3 +1,4 @@ + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Copyright by The HDF Group. * * Copyright by the Board of Trustees of the University of Illinois. * @@ -17,7 +18,6 @@ #include "H5f90.h" - /*---------------------------------------------------------------------------- * Name: h5pcreate_c * Purpose: Call H5Pcreate to create a property list @@ -2710,16 +2710,20 @@ int_f nh5pget_class_name_c(hid_t_f *class, _fcd name, int_f *name_len) { int_f ret_value = -1; - hid_t c_class; - char* c_name; - + char *c_name = NULL; /* Buffer to hold C string */ + size_t c_size; - c_class = (hid_t)*class; + c_size = (size_t)*name_len + 1; + /* + * Allocate buffer to hold name + */ + if ((c_name = HDmalloc(c_size)) == NULL) + goto DONE; /* * Call H5Pget_class_name function. */ - c_name = H5Pget_class_name(c_class); - if( c_name == NULL) goto DONE; + c_name = H5Pget_class_name((hid_t)*class); + if(c_name == NULL) goto DONE; HD5packFstring(c_name, _fcdtocp(name), (size_t)*name_len); ret_value = (int_f)HDstrlen(c_name); @@ -3131,7 +3135,7 @@ nh5pset_fapl_multi_sc ( hid_t_f *prp_id , int_f *flag) */ status = H5Pset_fapl_multi(c_prp_id, NULL, NULL, NULL, NULL, relax); - if ( status < 0 ) return ret_value; + if ( status < 0 ) return ret_value; /* error occurred */ ret_value = 0; return ret_value; } @@ -3414,3 +3418,1017 @@ DONE: return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5pget_attr_phase_change_c + * Purpose: Calls H5Pget_attr_phase_change + * + * Inputs: ocpl_id - Object (dataset or group) creation property list identifier + * Outputs max_compact - Maximum number of attributes to be stored in compact storage + * min_dense - Minimum number of attributes to be stored in dense storage + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_attr_phase_change_c(hid_t_f *ocpl_id, int_f *max_compact, int_f *min_dense ) +{ + int ret_value = -1; + hid_t c_ocpl_id; + unsigned c_max_compact; + unsigned c_min_dense; + herr_t ret; + /* + * Call H5Pget_attr_phase_change function. + */ + c_ocpl_id = (hid_t)*ocpl_id; + ret = H5Pget_attr_phase_change(c_ocpl_id, &c_max_compact,&c_min_dense); + if (ret < 0) return ret_value; + + *max_compact = (int_f)c_max_compact; + *min_dense = (int_f)c_min_dense; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_attr_creation_order_c + * Purpose: Calls H5Ppset_attr_creation_order + * + * Inputs: ocpl_id - Object (dataset or group) creation property list identifier + * Outputs crt_order_flags - Flags specifying whether to track and index attribute creation order + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags ) +{ + int ret_value = -1; + unsigned c_crt_order_flags; + herr_t ret; + /* + * Call h5pset_attr_creation_order function. + */ + c_crt_order_flags = (unsigned)*crt_order_flags; + ret = H5Pset_attr_creation_order((hid_t)*ocpl_id, c_crt_order_flags); + if (ret < 0) return ret_value; + + *crt_order_flags = (int_f)c_crt_order_flags; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_shared_mesg_nindexes_c + * Purpose: Calls h5pset_shared_mesg_nindexes + * + * Inputs: + * plist_id - file creation property list + * nindexes - Number of shared object header message indexes + * available in files created WITH this property list + * + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_shared_mesg_nindexes_c(hid_t_f *plist_id, int_f *nindexes ) +{ + int ret_value = -1; + hid_t c_plist_id; + unsigned c_nindexes; + herr_t ret; + /* + * Call h5pset_shared_mesg_nindexes function. + */ + c_plist_id = (hid_t)*plist_id; + c_nindexes = (unsigned)*nindexes; + ret = H5Pset_shared_mesg_nindexes(c_plist_id, c_nindexes ); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_shared_mesg_index_c + * Purpose: Calls H5Pset_shared_mesg_index + * + * Inputs: + * fcpl_id - File creation property list identifier. + * index_num - Index being configured. + * mesg_type_flags - Types of messages that should be stored in this index. + * min_mesg_size - Minimum message size. + * + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * January, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_shared_mesg_index_c(hid_t_f *fcpl_id, int_f *index_num, int_f *mesg_type_flags, int_f *min_mesg_size) +{ + int ret_value = -1; + herr_t ret; + /* + * Call h5pset_shared_mesg_index function. + */ + ret = H5Pset_shared_mesg_index((hid_t)*fcpl_id,(unsigned)*index_num, (unsigned)*mesg_type_flags, (unsigned)*min_mesg_size); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_attr_creation_order_c + * Purpose: Calls H5Pget_attr_creation_order + * + * Inputs: + * ocpl_id - Object (group or dataset) creation property list identifier + * Outputs: + * crt_order_flags - Flags specifying whether to track and index attribute creation order + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags) +{ + int ret_value = -1; + herr_t ret; + + unsigned c_crt_order_flags; + /* + * Call h5pget_attr_creation_order function. + */ + + ret = H5Pget_attr_creation_order((hid_t)*ocpl_id, &c_crt_order_flags); + if (ret < 0) return ret_value; + + *crt_order_flags = (int_f)c_crt_order_flags; + + ret_value = 0; + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5pset_libver_bounds_c + * Purpose: Calls H5Pset_libver_bounds + * + * Inputs: + * fapl_id - File access property list identifier + * low - The earliest version of the library that will be used for writing objects. + * high - The latest version of the library that will be used for writing objects. + * Outputs: + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 18, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_libver_bounds_c(hid_t_f *fapl_id, int_f *low, int_f *high ) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pset_libver_bounds function. + */ + ret = H5Pset_libver_bounds( (hid_t)*fapl_id, (H5F_libver_t)*low, (H5F_libver_t)*high ); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_link_creation_order_c + * Purpose: Calls H5Pset_link_creation_order + * + * Inputs: gcpl_id - Group creation property list identifier + * crt_order_flags - Creation order flag(s) + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 18, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_link_creation_order_c(hid_t_f *gcpl_id, int_f *crt_order_flags ) +{ + int ret_value = -1; + herr_t ret; + /* + * Call H5Pset_link_creation_order function. + */ + ret = H5Pset_link_creation_order((hid_t)*gcpl_id, (unsigned)*crt_order_flags); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_link_phase_change_c + * Purpose: Calls H5Pget_link_phase_change + * + * Inputs: gcpl_id - Group creation property list identifier + * Outputs max_compact - Maximum number of attributes to be stored in compact storage + * min_dense - Minimum number of attributes to be stored in dense storage + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 20, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_link_phase_change_c(hid_t_f *gcpl_id, int_f *max_compact, int_f *min_dense ) +{ + int ret_value = -1; + unsigned c_max_compact; + unsigned c_min_dense; + herr_t ret; + + /* + * Call H5Pget_link_phase_change function. + */ + ret = H5Pget_link_phase_change((hid_t)*gcpl_id, &c_max_compact,&c_min_dense); + if (ret < 0) return ret_value; + + *max_compact = (int_f)c_max_compact; + *min_dense = (int_f)c_min_dense; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_obj_track_times_c + * Purpose: Call H5Pget_obj_track_times + * + * Inputs: plist_id - property list id + * Outputs: + * flag - TRUE/FALSE flag + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 22, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_obj_track_times_c(hid_t_f *plist_id, int_f *flag) +{ + int ret_value = -1; + hbool_t c_track_times=0; + herr_t ret; + + /* + * Call H5Pget_obj_track_times function. + */ + ret = H5Pget_obj_track_times((hid_t)*plist_id, &c_track_times); + + if (ret < 0) return ret_value; /* error occurred */ + + *flag = 0; + if(c_track_times > 0) *flag = 1; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_obj_track_times_c + * Purpose: Call H5Pset_obj_track_times + * + * Inputs: plist_id - property list id + * flag - TRUE/FALSE flag + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 22, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_obj_track_times_c(hid_t_f *plist_id, int_f *flag) +{ + int ret_value = -1; + hbool_t c_track_times; + herr_t ret; + + + c_track_times = (hbool_t)*flag; + + /* + * Call H5Pset_obj_track_times function. + */ + ret = H5Pset_obj_track_times((hid_t)*plist_id, c_track_times); + + if (ret < 0) return ret_value; /* error occurred */ + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_create_inter_group_c + * Purpose: Calls H5Pset_create_intermediate_group + * + * Inputs: + * lcpl_id - Link creation property list identifier + * crt_intermed_group - crt_intermed_group specifying whether + * to create intermediate groups upon the + * creation of an object + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 22, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_create_inter_group_c(hid_t_f *lcpl_id, int_f *crt_intermed_group) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pset_create_intermediate_group function. + */ + ret = H5Pset_create_intermediate_group((hid_t)*lcpl_id, (unsigned)*crt_intermed_group); + + if (ret < 0) return ret_value; /* error occurred */ + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_link_creation_order_c + * Purpose: Calls H5Pget_link_creation_order + * + * Inputs: + * gcpl_id - Group creation property list identifier + * Outputs: + * crt_order_flags - Creation order flag(s) + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_link_creation_order_c(hid_t_f *gcpl_id, int_f *crt_order_flags) +{ + int ret_value = -1; + herr_t ret; + + unsigned c_crt_order_flags; + /* + * Call h5pget_link_creation_order function. + */ + + ret = H5Pget_link_creation_order((hid_t)*gcpl_id, &c_crt_order_flags); + if (ret < 0) return ret_value; + + *crt_order_flags = (int_f)c_crt_order_flags; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_char_encoding_c + * Purpose: Calls H5Pset_char_encoding + * + * Inputs: + * plist_id - Property list identifier + * encoding - String encoding character set: + * H5T_CSET_ASCII_F -> US ASCII + * H5T_CSET_UTF8_F -> UTF-8 Unicode encoding + * Outputs: NONE + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_char_encoding_c(hid_t_f *plist_id, int_f *encoding) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pset_char_encoding function. + */ + ret = H5Pset_char_encoding((hid_t)*plist_id, (H5T_cset_t)*encoding); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + + +/*---------------------------------------------------------------------------- + * Name: h5pget_char_encoding_c + * Purpose: Calls H5Pget_char_encoding + * + * Inputs: + * plist_id - Property list identifier + * Outputs: + * encoding - Encoding character set: + * H5T_CSET_ASCII_F -> US ASCII + * H5T_CSET_UTF8_F -> UTF-8 Unicode encoding + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_char_encoding_c(hid_t_f *plist_id, int_f *encoding) +{ + int ret_value = -1; + H5T_cset_t c_encoding; + herr_t ret; + /* + * Call H5Pget_char_encoding function. + */ + ret = H5Pget_char_encoding((hid_t)*plist_id, &c_encoding); + if (ret < 0) return ret_value; + + *encoding = (int_f)c_encoding; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_copy_object_c + * Purpose: Calls H5Pset_copy_object + * + * Inputs: + * ocp_plist_id - Object copy property list identifier + * copy_options - Copy option(s) to be set + * + * Outputs: + * NONE + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_copy_object_c(hid_t_f *ocp_plist_id, int_f *copy_options) +{ + int ret_value = -1; + herr_t ret; + /* + * Call H5Pset_copy_object function. + */ + ret = H5Pset_copy_object((hid_t)*ocp_plist_id, (unsigned)*copy_options); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_copy_object_c + * Purpose: Calls H5Pget_copy_object + * + * Inputs: + * ocp_plist_id - Object copy property list identifier + * + * Outputs: + * copy_options - Copy option(s) to be get + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 3, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_copy_object_c(hid_t_f *ocp_plist_id, int_f *copy_options) +{ + int ret_value = -1; + unsigned c_copy_options; + herr_t ret; + /* + * Call H5Pget_copy_object function. + */ + ret = H5Pget_copy_object((hid_t)*ocp_plist_id, &c_copy_options); + if (ret < 0) return ret_value; + + *copy_options = (int_f)c_copy_options; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_data_transform_c + * Purpose: Calls H5Pget_data_transform + * Inputs: + * prp_id - property list identifier to query + * expression_len - buffer size transorm expression + * + * Output: + * expression - buffer to hold transform expression + * + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 19, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_data_transform_c(hid_t_f *plist_id, _fcd expression, int_f *expression_len, size_t_f *size) +{ + int_f ret_value = -1; + char *c_expression = NULL; /* Buffer to hold C string */ + size_t c_expression_len; + ssize_t ret; + + + c_expression_len = (size_t)*expression_len + 1; + + /* should expression_len be size_t_f? */ + /* + * Allocate memory to store the expression. + */ + if( c_expression_len) c_expression = (char*) HDmalloc(c_expression_len); + if (c_expression == NULL) return ret_value; + + /* + * Call h5pget_data_transform function. + */ + ret = H5Pget_data_transform((hid_t)*plist_id, c_expression, c_expression_len); + if(ret < 0) return ret_value; + /* or strlen ? */ + HD5packFstring(c_expression, _fcdtocp(expression), c_expression_len-1); + + *size = (size_t_f)ret; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_data_transform_c + * Purpose: Calls H5Pset_data_transform + * Inputs: + * prp_id - property list identifier to query + * expression - buffer to hold transform expression + * expression_len - buffer size transorm expression + * + * Output: + * + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 19, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_data_transform_c(hid_t_f *plist_id, _fcd expression, int_f *expression_len) +{ + int_f ret_value = -1; /* Return value */ + char* c_expression = NULL; /* Buffer to hold C string */ + herr_t ret; + /* + * Convert FORTRAN name to C name + */ + if(NULL == (c_expression = HD5f2cstring(expression, (size_t)*expression_len))) + return ret_value; + /* + * Call h5pset_data_transform function. + */ + ret = H5Pset_data_transform((hid_t)*plist_id, c_expression); + if(ret<0) return ret_value; + + ret_value = 0; + if(c_expression) + HDfree(c_expression); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_local_heap_size_hint_c + * Purpose: Calls H5Pget_local_heap_size_hint + * Inputs: + * gcpl_id - Group creation property list identifier + * + * Output: + * size_hint - Hint for size of local heap + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_local_heap_size_hint_c(hid_t_f *gcpl_id, size_t_f *size_hint) +{ + int_f ret_value = -1; /* Return value */ + size_t c_size_hint; + herr_t ret; + /* + * Call H5Pget_local_heap_size_hint function. + */ + ret = H5Pget_local_heap_size_hint((hid_t)*gcpl_id, &c_size_hint); + if(ret<0) return ret_value; + + *size_hint = (size_t_f)c_size_hint; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_est_link_info_c + * Purpose: Calls H5Pget_est_link_info + * Inputs: + * gcpl_id - Group creation property list identifier + * + * Output: + * est_num_entries - Estimated number of links to be inserted into group + * est_name_len - Estimated average length of link names + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_est_link_info_c(hid_t_f *gcpl_id, int_f *est_num_entries, int_f *est_name_len) +{ + int_f ret_value = -1; /* Return value */ + unsigned c_est_num_entries; + unsigned c_est_name_len; + herr_t ret; + /* + * Call h5pget_est_link_info function. + */ + ret = H5Pget_est_link_info((hid_t)*gcpl_id, &c_est_num_entries, &c_est_name_len); + if(ret<0) return ret_value; + + *est_num_entries = (int_f)c_est_num_entries; + *est_name_len = (int_f)c_est_name_len; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_local_heap_size_hint_c + * Purpose: Calls H5Pset_local_heap_size_hint + * Inputs: + * gcpl_id - Group creation property list identifier + * size_hint - Hint for size of local heap + * + * Output: + * + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_local_heap_size_hint_c(hid_t_f *gcpl_id, size_t_f *size_hint) +{ + int_f ret_value = -1; /* Return value */ + herr_t ret; + /* + * Call H5Pget_local_heap_size_hint function. + */ + ret = H5Pset_local_heap_size_hint((hid_t)*gcpl_id, (size_t)*size_hint); + if(ret<0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_est_link_info_c + * Purpose: Calls H5Pset_est_link_info + * Inputs: + * gcpl_id - Group creation property list identifier + * est_num_entries - Estimated number of links to be inserted into group + * est_name_len - Estimated average length of link names + * + * Output: + * Returns: + * Success: 0 + * Failure: -1 + * + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_est_link_info_c(hid_t_f *gcpl_id, int_f *est_num_entries, int_f *est_name_len) +{ + int_f ret_value = -1; /* Return value */ + herr_t ret; + /* + * Call h5pset_est_link_info function. + */ + ret = H5Pset_est_link_info((hid_t)*gcpl_id, (unsigned)*est_num_entries, (unsigned)*est_name_len); + if(ret<0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_link_phase_change_c + * Purpose: Calls H5Pset_link_phase_change + * + * Inputs: gcpl_id - Group creation property list identifier + * max_compact - Maximum number of attributes to be stored in compact storage + * min_dense - Minimum number of attributes to be stored in dense storage + * Outputs + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_link_phase_change_c(hid_t_f *gcpl_id, int_f *max_compact, int_f *min_dense ) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pset_link_phase_change function. + */ + ret = H5Pset_link_phase_change((hid_t)*gcpl_id, (unsigned)*max_compact,(unsigned)*min_dense); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_fapl_direct_c + * Purpose: Calls H5Pset_fapl_direct + * + * Inputs: + * fapl_id - File access property list identifier + * alignment - Required memory alignment boundary + * block_size - File system block size + * cbuf_size - Copy buffer size + * Outputs + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_fapl_direct_c(hid_t_f *fapl_id, size_t_f *alignment, size_t_f *block_size, size_t_f *cbuf_size ) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pset_link_phase_change function. + */ +#ifdef H5_HAVE_DIRECT + ret = H5Pset_fapl_direct((hid_t)*fapl_id, (size_t)*alignment, (size_t)*block_size, (size_t)*cbuf_size ); + if (ret < 0) return ret_value; + + ret_value = 0; + +#endif + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_fapl_direct_c + * Purpose: Calls H5Pget_fapl_direct + * + * Inputs: + * fapl_id - File access property list identifier + * Outputs: + * alignment - Required memory alignment boundary + * block_size - File system block size + * cbuf_size - Copy buffer size + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_fapl_direct_c(hid_t_f *fapl_id, size_t_f *alignment, size_t_f *block_size, size_t_f *cbuf_size ) +{ + int ret_value = -1; + herr_t ret; + size_t c_alignment; + size_t c_block_size; + size_t c_cbuf_size; + + /* + * Call H5Pget_link_phase_change function. + */ +#ifdef H5_HAVE_DIRECT + ret = H5Pget_fapl_direct((hid_t)*fapl_id, &c_alignment, &c_block_size, &c_cbuf_size ); + if (ret < 0) return ret_value; + + *alignment = (size_t_f)c_alignment; + *block_size = (size_t_f)c_block_size; + *cbuf_size = (size_t_f)c_cbuf_size; + + ret_value = 0; +#endif + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_attr_phase_change_c + * Purpose: Calls H5Pset_attr_phase_change + * + * Inputs: ocpl_id - Object (dataset or group) creation property list identifier + * max_compact - Maximum number of attributes to be stored in compact storage + * min_dense - Minimum number of attributes to be stored in dense storage + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_attr_phase_change_c(hid_t_f *ocpl_id, int_f *max_compact, int_f *min_dense ) +{ + int ret_value = -1; + herr_t ret; + /* + * Call H5Pset_attr_phase_change function. + */ + ret = H5Pset_attr_phase_change((hid_t)*ocpl_id, (unsigned)*max_compact,(unsigned)*min_dense); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_nbit_c + * Purpose: Calls H5Pset_nbit + * + * Inputs: plist_id - Dataset creation property list identifier + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_nbit_c(hid_t_f *plist_id ) +{ + int ret_value = -1; + herr_t ret; + /* + * Call H5Pset_nbit_change function. + */ + ret = H5Pset_nbit((hid_t)*plist_id); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} +/*---------------------------------------------------------------------------- + * Name: h5pset_scaleoffset_c + * Purpose: Calls H5Pset_scaleoffset + * + * Inputs: + * plist_id - Dataset creation property list identifier + * scale_type - Flag indicating compression method. + * scale_factor - Parameter related to scale. + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 21, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_scaleoffset_c(hid_t_f *plist_id, int_f *scale_type, int_f *scale_factor ) +{ + int ret_value = -1; + H5Z_SO_scale_type_t c_scale_type; + herr_t ret; + /* + * Call H5Pset_scaleoffset_change function. + */ + c_scale_type = (H5Z_SO_scale_type_t)*scale_type; + + ret = H5Pset_scaleoffset((hid_t)*plist_id, c_scale_type, (int)*scale_factor); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pset_nlinks + * Purpose: Calls H5Pset_nlinks + * + * Inputs: + * lapl_id - File access property list identifier + * nlinks - Maximum number of links to traverse + * Outputs: + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 24, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pset_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks) +{ + int ret_value = -1; + herr_t ret; + /* + * Call H5Pset_nlinks function. + */ + ret = H5Pset_nlinks((hid_t)*lapl_id, (size_t)*nlinks); + if (ret < 0) return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_nlinks + * Purpose: Calls H5Pget_nlinks + * + * Inputs: + * lapl_id - File access property list identifier + * + * Outputs: + * nlinks - Maximum number of links to traverse + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 24, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks) +{ + int ret_value = -1; + herr_t ret; + size_t c_nlinks; + /* + * Call H5Pget_nlinks function. + */ + ret = H5Pget_nlinks((hid_t)*lapl_id, &c_nlinks); + if (ret < 0) return ret_value; + + *nlinks = (size_t_f)c_nlinks; + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_create_inter_group_c + * Purpose: Calls H5Pget_create_intermediate_group + * + * Inputs: + * lcpl_id - Link creation property list identifier + * crt_intermed_group - Specifying whether to create intermediate groups upon + * the creation of an object + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 4, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_create_inter_group_c(hid_t_f *lcpl_id, int_f *crt_intermed_group) +{ + int ret_value = -1; + herr_t ret; + + /* + * Call H5Pget_create_intermediate_group function. + */ + ret = H5Pget_create_intermediate_group((hid_t)*lcpl_id, (unsigned)*crt_intermed_group); + + if (ret < 0) return ret_value; /* error occurred */ + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90 index 1c1fb90..ed935e9 100644 --- a/fortran/src/H5Pff.f90 +++ b/fortran/src/H5Pff.f90 @@ -1943,7 +1943,7 @@ hdferr = h5pget_fapl_core_c(prp_id, increment, backing_store_flag) backing_store =.FALSE. - if (backing_store_flag .eq. 1) backing_store =.TRUE. + IF (backing_store_flag .EQ. 1) backing_store =.TRUE. END SUBROUTINE h5pget_fapl_core_f !---------------------------------------------------------------------- @@ -4665,19 +4665,18 @@ !---------------------------------------------------------------------- ! Name: h5pget_class_name_f ! -! Purpose: Queries the ithe name of a class. +! Purpose: Queries the name of a class. ! ! Inputs: ! prp_id - property list identifier to query ! Outputs: ! name - name of a class -! hdferr: - error code -! -! Success: Actual lenght of the class name -! If provided buffer "name" is -! smaller, than name will be -! truncated to fit into -! provided user buffer +! size - Actual length of the class name +! If provided buffer "name" is smaller, +! than name will be truncated to fit into +! provided user buffer +! hdferr: - error code +! Success: 0 ! Failure: -1 ! Optional parameters: ! NONE @@ -4685,12 +4684,12 @@ ! Programmer: Elena Pourmal ! October 9, 2002 ! -! Modifications: +! Modifications: Returned the size of name as an argument ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5pget_class_name_f(prp_id, name, hdferr) + SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) @@ -4699,7 +4698,9 @@ ! IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - CHARACTER(LEN=*), INTENT(INOUT) :: name ! Buffer to retireve class name + CHARACTER(LEN=*), INTENT(OUT) :: name ! Buffer to retireve class name + + INTEGER, INTENT(OUT) :: size ! Actual length of the class name INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER :: name_len @@ -4715,8 +4716,13 @@ INTEGER, INTENT(IN) :: name_len END FUNCTION h5pget_class_name_c END INTERFACE + name_len = LEN(name) - hdferr = h5pget_class_name_c(prp_id, name , name_len) + size = h5pget_class_name_c(prp_id, name, name_len) + + hdferr = 0 + IF(size.LT.0) hdferr = -1 + END SUBROUTINE h5pget_class_name_f !---------------------------------------------------------------------- @@ -6387,4 +6393,1764 @@ hdferr = h5premove_filter_c(prp_id, filter) END SUBROUTINE h5premove_filter_f - END MODULE H5P +!---------------------------------------------------------------------- +! Name: H5Pget_attr_phase_change_f +! +! Purpose: Retrieves attribute storage phase change thresholds +! +! Inputs: +! ocpl_id - Object (dataset or group) creation property list identifier +! Outputs: +! max_compact - Maximum number of attributes to be stored in compact storage +! (Default: 8) +! min_dense - Minimum number of attributes to be stored in dense storage +! (Default: 6) +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_attr_phase_change_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier + INTEGER, INTENT(OUT) :: max_compact ! Maximum number of attributes to be stored in compact storage + !(Default: 8) + INTEGER, INTENT(OUT) :: min_dense ! Minimum number of attributes to be stored in dense storage + ! (Default: 6) + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_attr_phase_change_c(ocpl_id, max_compact, min_dense) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_ATTR_PHASE_CHANGE_C'::h5pget_attr_phase_change_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocpl_id + INTEGER, INTENT(OUT) :: max_compact + INTEGER, INTENT(OUT) :: min_dense + + END FUNCTION h5pget_attr_phase_change_c + END INTERFACE + + hdferr = h5pget_attr_phase_change_c(ocpl_id, max_compact, min_dense) + END SUBROUTINE h5pget_attr_phase_change_f + +!---------------------------------------------------------------------- +! Name: H5Pset_attr_creation_order_f +! +! Purpose: Sets tracking and indexing of attribute creation order +! +! Inputs: +! ocpl_id - Object creation property list identifier +! crt_order_flags - Flags specifying whether to track and index attribute creation order +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_attr_creation_order_f(ocpl_id, crt_order_flags , hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_attr_creation_order_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier + INTEGER, INTENT(IN) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order + + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_attr_creation_order_c(ocpl_id, crt_order_flags) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_ATTR_CREATION_ORDER_C'::h5pset_attr_creation_order_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocpl_id + INTEGER, INTENT(IN) :: crt_order_flags + + END FUNCTION H5Pset_attr_creation_order_c + END INTERFACE + + hdferr = H5Pset_attr_creation_order_c(ocpl_id, crt_order_flags) + END SUBROUTINE h5pset_attr_creation_order_f + + +!---------------------------------------------------------------------- +! Name: H5Pset_shared_mesg_nindexes_f +! +! Purpose: Sets number of shared object header message indexes +! +! Inputs: +! plist_id - file creation property list +! nindexes - Number of shared object header message indexes to be available in files created with this property list +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_shared_mesg_nindexes_f( plist_id, nindexes, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_shared_mesg_nindexes_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! file creation property list + INTEGER, INTENT(IN) :: nindexes ! Number of shared object header message indexes + ! available in files created WITH this property list + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_shared_mesg_nindexes_c(plist_id, nindexes) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_SHARED_MESG_NINDEXES_C'::h5pset_shared_mesg_nindexes_c + !DEC$ ENDIF + + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(IN) :: nindexes + + END FUNCTION H5pset_shared_mesg_nindexes_c + END INTERFACE + + hdferr = h5pset_shared_mesg_nindexes_c(plist_id, nindexes) + + END SUBROUTINE h5pset_shared_mesg_nindexes_f + +!---------------------------------------------------------------------- +! Name: H5Pset_shared_mesg_index_f +! +! Purpose: Configures the specified shared object header message index +! +! Inputs: +! fcpl_id - File creation property list identifier. +! index_num - Index being configured. +! mesg_type_flags - Types of messages that should be stored in this index. +! min_mesg_size - Minimum message size. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_shared_mesg_index_f(fcpl_id, index_num, mesg_type_flags, min_mesg_size, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_shared_mesg_index_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fcpl_id ! file creation property list + INTEGER, INTENT(IN) :: index_num ! Index being configured. + INTEGER, INTENT(IN) :: mesg_type_flags ! Types of messages that should be stored in this index. + INTEGER, INTENT(IN) :: min_mesg_size ! Minimum message size. + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_shared_mesg_index_c(fcpl_id, index_num, mesg_type_flags, min_mesg_size) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_SHARED_MESG_INDEX_C'::h5pset_shared_mesg_index_c + !DEC$ ENDIF + + INTEGER(HID_T), INTENT(IN) :: fcpl_id + INTEGER, INTENT(IN) :: index_num + INTEGER, INTENT(IN) :: mesg_type_flags + INTEGER, INTENT(IN) :: min_mesg_size + + END FUNCTION H5pset_shared_mesg_index_c + END INTERFACE + + hdferr = h5pset_shared_mesg_index_c(fcpl_id, index_num, mesg_type_flags, min_mesg_size) + + END SUBROUTINE h5pset_shared_mesg_index_f + +!---------------------------------------------------------------------- +! Name: H5Pget_attr_creation_order_f +! +! Purpose: Retrieves tracking and indexing settings for attribute creation order +! +! Inputs: +! ocpl_id - Object (group or dataset) creation property list identifier +! +! Outputs: +! crt_order_flags - Flags specifying whether to track and index attribute creation order +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_attr_creation_order_f(ocpl_id, crt_order_flags, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_attr_creation_order_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (group or dataset) creation property list identifier + INTEGER, INTENT(OUT) :: crt_order_flags ! Flags specifying whether to track and index attribute creation order + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_attr_creation_order_c(ocpl_id, crt_order_flags) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_ATTR_CREATION_ORDER_C'::h5pget_attr_creation_order_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocpl_id + INTEGER, INTENT(OUT) :: crt_order_flags + + END FUNCTION H5pget_attr_creation_order_c + END INTERFACE + + hdferr = h5pget_attr_creation_order_c(ocpl_id, crt_order_flags) + + END SUBROUTINE h5pget_attr_creation_order_f + +!---------------------------------------------------------------------- +! Name: H5Pset_libver_bounds_f +! +! Purpose: Sets bounds on library versions, and indirectly format versions, to be used when creating objects. +! +! Inputs: +! fapl_id - File access property list identifier +! low - The earliest version of the library that will be used for writing objects. +! high - The latest version of the library that will be used for writing objects. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 18, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_libver_bounds_f(fapl_id, low, high, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_libver_bounds_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier + INTEGER(HID_T), INTENT(IN) :: low ! The earliest version of the library that will be used for writing objects. + ! Currently, low must be one of two pre-defined values: + ! HDF_LIBVER_EARLIEST_F + ! HDF_LIBVER_LATEST_F + INTEGER(HID_T), INTENT(IN) :: high ! The latest version of the library that will be used for writing objects. + ! Currently, low must set to the pre-defined value: + ! HDF_LIBVER_LATEST_F + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_libver_bounds_c(fapl_id, low, high) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_LIBVER_BOUNDS_C'::h5pset_libver_bounds_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: fapl_id + INTEGER(HID_T), INTENT(IN) :: low + INTEGER(HID_T), INTENT(IN) :: high + + END FUNCTION H5pset_libver_bounds_c + END INTERFACE + + hdferr = h5pset_libver_bounds_c(fapl_id, low, high) + + END SUBROUTINE h5pset_libver_bounds_f + +!---------------------------------------------------------------------- +! Name: H5Pset_link_creation_order_f +! +! Purpose: Sets creation order tracking and indexing for links in a group. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! crt_order_flags - Creation order flag(s) +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 18, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_libver_bounds_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! File access property list identifier + INTEGER(HID_T), INTENT(IN) :: crt_order_flags ! Creation order flag(s) + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_link_creation_order_c(gcpl_id, crt_order_flags) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_LINK_CREATION_ORDER_C'::h5pset_link_creation_order_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER(HID_T), INTENT(IN) :: crt_order_flags + + END FUNCTION H5pset_link_creation_order_c + END INTERFACE + + hdferr = h5pset_link_creation_order_c(gcpl_id, crt_order_flags) + + END SUBROUTINE h5pset_link_creation_order_f + +!---------------------------------------------------------------------- +! Name: H5Pget_link_phase_change_f +! +! Purpose: Queries the settings for conversion between compact and dense groups. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! Outputs: +! max_compact - Maximum number of attributes to be stored in compact storage +! min_dense - Minimum number of attributes to be stored in dense storage +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 20, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_link_phase_change_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER, INTENT(OUT) :: max_compact ! Maximum number of attributes to be stored in compact storage + INTEGER, INTENT(OUT) :: min_dense ! Minimum number of attributes to be stored in dense storage + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_link_phase_change_c(gcpl_id, max_compact, min_dense) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_LINK_PHASE_CHANGE_C'::h5pget_link_phase_change_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER, INTENT(OUT) :: max_compact + INTEGER, INTENT(OUT) :: min_dense + + END FUNCTION h5pget_link_phase_change_c + END INTERFACE + + hdferr = h5pget_link_phase_change_c(gcpl_id, max_compact, min_dense) + END SUBROUTINE h5pget_link_phase_change_f + +!---------------------------------------------------------------------- +! Name: H5Pget_obj_track_times_f +! +! Purpose: Returns whether times are tracked for an object. +! +! Inputs: +! plist_id - property list id +! flag - object timestamp setting +! .TRUE.,.FALSE. +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 22, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_obj_track_times_f(plist_id, flag, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_obj_track_times_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property + ! list identifier + LOGICAL, INTENT(OUT) :: flag ! Object timestamp setting + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: status +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_obj_track_times_c(plist_id, status) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_OBJ_TRACK_TIMES_C'::h5pget_obj_track_times_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier + INTEGER, INTENT(OUT) :: status + END FUNCTION h5pget_obj_track_times_c + END INTERFACE + flag = .TRUE. + hdferr = h5pget_obj_track_times_c(plist_id, status) + IF(status.EQ.0) flag = .FALSE. + + END SUBROUTINE h5pget_obj_track_times_f + +!---------------------------------------------------------------------- +! Name: H5Pset_obj_track_times_f +! +! Purpose: Set whether the birth, access, modification & change times for +! an object are stored. +! +! Birth time is the time the object was created. Access time is +! the last time that metadata or raw data was read from this +! object. Modification time is the last time the data for +! this object was changed (either writing raw data to a dataset +! or inserting/modifying/deleting a link in a group). Change +! time is the last time the metadata for this object was written +! (adding/modifying/deleting an attribute on an object, extending +! the size of a dataset, etc). +! +! If these times are not tracked, they will be reported as +! 12:00 AM UDT, Jan. 1, 1970 (i.e. 0 seconds past the UNIX +! epoch) when queried. +! +! Inputs: +! plist_id - property list id +! flag - object timestamp setting +! .TRUE.,.FALSE. +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 22, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_obj_track_times_f(plist_id, flag, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_obj_track_times_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property + ! list identifier + LOGICAL, INTENT(IN) :: flag ! Object timestamp setting + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: status +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_obj_track_times_c(plist_id, status) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_OBJ_TRACK_TIMES_C'::h5pset_obj_track_times_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id ! File creation property list identifier + INTEGER, INTENT(IN) :: status + END FUNCTION h5pset_obj_track_times_c + END INTERFACE + + status = 0 + IF(flag) status = 1 + + hdferr = h5pset_obj_track_times_c(plist_id, status) + + END SUBROUTINE h5pset_obj_track_times_f + +!---------------------------------------------------------------------- +! Name: H5Pset_create_inter_group_f +! +! Purpose: Specifies in property list whether to create missing intermediate groups. +! +! Inputs: +! lcpl_id - Link creation property list identifier +! crt_intermed_group - crt_intermed_group specifying whether +! to create intermediate groups upon the creation +! of an object +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! February 22, 2008 +! +! Modifications: +! +! Comment: The long subroutine name (>31) on older f90 compilers causes problems +! so had to shorten the name +!-------------------------------------------------------------------------------------- + + SUBROUTINE h5pset_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_create_inter_group_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier + INTEGER, INTENT(IN) :: crt_intermed_group ! specifying whether to create intermediate groups + ! upon the creation of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_create_inter_group_c(lcpl_id, crt_intermed_group) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_CREATE_INTER_GROUP_C'::h5pset_create_inter_group_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: lcpl_id + INTEGER(HID_T), INTENT(IN) :: crt_intermed_group + END FUNCTION h5pset_create_inter_group_c + END INTERFACE + + hdferr = h5pset_create_inter_group_c(lcpl_id, crt_intermed_group) + + END SUBROUTINE h5pset_create_inter_group_f + +!---------------------------------------------------------------------- +! Name: H5Pget_link_creation_order_f +! +! Purpose: Queries whether link creation order is tracked and/or indexed in a group. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! +! Outputs: +! crt_order_flags - Creation order flag(s) +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_link_creation_order_f(gcpl_id, crt_order_flags, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_link_creation_order_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER, INTENT(OUT) :: crt_order_flags ! Creation order flag(s) + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_link_creation_order_c(gcpl_id, crt_order_flags) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_LINK_CREATION_ORDER_C'::h5pget_link_creation_order_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER, INTENT(OUT) :: crt_order_flags + + END FUNCTION H5pget_link_creation_order_c + END INTERFACE + + hdferr = h5pget_link_creation_order_c(gcpl_id, crt_order_flags) + + END SUBROUTINE h5pget_link_creation_order_f + +!---------------------------------------------------------------------- +! Name: H5Pset_char_encoding +! +! Purpose: Sets the character encoding used to encode a string. +! +! Inputs: +! plist_id - Property list identifier +! encoding - Valid values for encoding are: +! H5T_CSET_ASCII_F -> US ASCII +! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_char_encoding_f(plist_id, encoding, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_attr_creation_order_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier + + INTEGER, INTENT(IN) :: encoding ! String encoding character set: +! H5T_CSET_ASCII_F -> US ASCII +! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_char_encoding_c(plist_id, encoding) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_CHAR_ENCODING_C'::h5pset_char_encoding_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(IN) :: encoding + + END FUNCTION H5pset_char_encoding_c + END INTERFACE + + hdferr = h5pset_char_encoding_c(plist_id, encoding) + + END SUBROUTINE h5pset_char_encoding_f + +!---------------------------------------------------------------------- +! Name: H5Pget_char_encoding +! +! Purpose: Retrieves the character encoding used to create a string +! +! Inputs: +! plist_id - Property list identifier +! +! Outputs: +! encoding - Valid values for encoding are: +! H5T_CSET_ASCII_F -> US ASCII +! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_char_encoding_f(plist_id, encoding, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_char_encoding_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Property list identifier + + INTEGER, INTENT(OUT) :: encoding ! Valid values for encoding are: +! H5T_CSET_ASCII_F -> US ASCII +! H5T_CSET_UTF8_F -> UTF-8 Unicode encoding + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_char_encoding_c(plist_id, encoding) + + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_CHAR_ENCODING_C'::h5pget_char_encoding_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(OUT) :: encoding + + END FUNCTION H5pget_char_encoding_c + END INTERFACE + + hdferr = h5pget_char_encoding_c(plist_id, encoding) + + END SUBROUTINE h5pget_char_encoding_f + +!---------------------------------------------------------------------- +! Name: h5pset_copy_object_f +! +! Purpose: Sets properties to be used when an object is copied. +! +! Inputs: +! ocp_plist_id - Object copy property list identifier +! copy_options - Copy option(s) to be set +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_copy_object_f(ocp_plist_id, copy_options, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_copy_object_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier + INTEGER, INTENT(IN) :: copy_options ! Copy option(s) to be set, valid options are: + ! H5O_COPY_SHALLOW_HIERARCHY_F + ! H5O_COPY_EXPAND_SOFT_LINK_F + ! H5O_COPY_EXPAND_EXT_LINK_F + ! H5O_COPY_EXPAND_REFERENCE_F + ! H5O_COPY_WITHOUT_ATTR_FLAG_F + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_copy_object_c(ocp_plist_id, copy_options) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_COPY_OBJECT_C'::h5pset_copy_object_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocp_plist_id + INTEGER, INTENT(IN) :: copy_options + END FUNCTION h5pset_copy_object_c + END INTERFACE + hdferr = h5pset_copy_object_c(ocp_plist_id, copy_options) + END SUBROUTINE h5pset_copy_object_f + +!---------------------------------------------------------------------- +! Name: h5pget_copy_object_f +! +! Purpose: Retrieves the properties to be used when an object is copied. +! +! Inputs: +! ocp_plist_id - Object copy property list identifier +! Outputs: +! copy_options - Copy option(s) to be get +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 3, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_copy_object_f(ocp_plist_id, copy_options, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_copy_object_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocp_plist_id ! Object copy property list identifier + INTEGER, INTENT(OUT) :: copy_options ! valid copy options returned are: + ! H5O_COPY_SHALLOW_HIERARCHY_F + ! H5O_COPY_EXPAND_SOFT_LINK_F + ! H5O_COPY_EXPAND_EXT_LINK_F + ! H5O_COPY_EXPAND_REFERENCE_F + ! H5O_COPY_WITHOUT_ATTR_FLAG_F + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_copy_object_c(ocp_plist_id, copy_options) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_COPY_OBJECT_C'::h5pget_copy_object_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocp_plist_id + INTEGER, INTENT(OUT) :: copy_options + END FUNCTION h5pget_copy_object_c + END INTERFACE + hdferr = h5pget_copy_object_c(ocp_plist_id, copy_options) + END SUBROUTINE h5pget_copy_object_f + +!---------------------------------------------------------------------- +! Name: h5pget_data_transform_f +! +! Purpose: Retrieves a data transform expression. +! +! Inputs: +! plist_id - Identifier of the property list or class +! Outputs: +! expression - buffer to hold transform expression +! hdferr - error code +! Success: Actual lenght of the expression +! If provided buffer "expression" is +! smaller, than expression will be +! truncated to fit into +! provided user buffer +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 19, 2008 +! +! Modifications: +! +! Comment: Should hdferr return just 0 or 1 and add another arguement for the size? +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_data_transform_f(plist_id, expression, hdferr, size) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_data_transform_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class + CHARACTER(LEN=*), INTENT(OUT) :: expression ! Buffer to hold transform expression + + INTEGER(SIZE_T), INTENT(OUT), OPTIONAL :: size ! registered size of the transform expression + + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: expression_len + INTEGER(SIZE_T) :: size_default + + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_data_transform_c(plist_id, expression, expression_len, size_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_DATA_TRANSFORM_C'::h5pget_data_transform_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + CHARACTER(LEN=*), INTENT(OUT) :: expression + INTEGER(SIZE_T) :: size_default + INTEGER :: expression_len + END FUNCTION h5pget_data_transform_c + END INTERFACE + + size_default = 0 + expression_len = LEN(expression) + + hdferr = h5pget_data_transform_c(plist_id, expression, expression_len, size_default) + + IF(present(size)) size = size_default + + END SUBROUTINE h5pget_data_transform_f + +!---------------------------------------------------------------------- +! Name: h5pset_data_transform_f +! +! Purpose: Sets a data transform expression. +! +! Inputs: +! plist_id - Identifier of the property list or class +! expression - buffer to hold transform expression +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 19, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_data_transform_f(plist_id, expression, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_data_transform_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Identifier of the property list or class + CHARACTER(LEN=*), INTENT(IN) :: expression ! Buffer to hold transform expression + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER :: expression_len + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_data_transform_c(plist_id, expression, expression_len) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_DATA_TRANSFORM_C'::h5pset_data_transform_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + CHARACTER(LEN=*), INTENT(IN) :: expression + INTEGER :: expression_len + END FUNCTION h5pset_data_transform_c + END INTERFACE + + expression_len = LEN(expression) + hdferr = h5pset_data_transform_c(plist_id, expression, expression_len) + + END SUBROUTINE h5pset_data_transform_f + +!---------------------------------------------------------------------- +! Name: H5Pget_local_heap_size_hint_f +! +! Purpose: Queries the local heap size hint for original-style groups. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! Outputs: +! size_hint - Hint for size of local heap +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pget_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_local_heap_size_hint_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER(SIZE_T), INTENT(OUT) :: size_hint ! Hint for size of local heap + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pget_local_heap_size_hint_c(gcpl_id, size_hint) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_LOCAL_HEAP_SIZE_HINT_C'::h5pget_local_heap_size_hint_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER(SIZE_T), INTENT(OUT) :: size_hint + END FUNCTION H5Pget_local_heap_size_hint_c + END INTERFACE + + hdferr = H5Pget_local_heap_size_hint_c(gcpl_id, size_hint) + + END SUBROUTINE H5Pget_local_heap_size_hint_f + +!---------------------------------------------------------------------- +! Name: H5Pget_est_link_info_f +! +! Purpose: Queries data required to estimate required local heap or object header size. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! Outputs: +! est_num_entries - Estimated number of links to be inserted into group +! est_name_len - Estimated average length of link names +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pget_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_est_link_info_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER, INTENT(OUT) :: est_num_entries ! Estimated number of links to be inserted into group + INTEGER, INTENT(OUT) :: est_name_len ! Estimated average length of link names + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pget_est_link_info_c(gcpl_id, est_num_entries, est_name_len) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_EST_LINK_INFO_C'::h5pget_est_link_info_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER, INTENT(OUT) :: est_num_entries + INTEGER, INTENT(OUT) :: est_name_len + END FUNCTION H5Pget_est_link_info_c + END INTERFACE + + hdferr = H5Pget_est_link_info_c(gcpl_id, est_num_entries, est_name_len) + + END SUBROUTINE H5Pget_est_link_info_f + +!---------------------------------------------------------------------- +! Name: H5Pset_local_heap_size_hint_f +! +! Purpose: Sets the local heap size hint for original-style groups. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! size_hint - Hint for size of local heap +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pset_local_heap_size_hint_f(gcpl_id, size_hint, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_local_heap_size_hint_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER(SIZE_T), INTENT(IN) :: size_hint ! Hint for size of local heap + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_local_heap_size_hint_c(gcpl_id, size_hint) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_LOCAL_HEAP_SIZE_HINT_C'::h5pset_local_heap_size_hint_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER(SIZE_T), INTENT(IN) :: size_hint + END FUNCTION H5Pset_local_heap_size_hint_c + END INTERFACE + + hdferr = H5Pset_local_heap_size_hint_c(gcpl_id, size_hint) + + END SUBROUTINE H5Pset_local_heap_size_hint_f + +!---------------------------------------------------------------------- +! Name: H5Pset_est_link_info_f +! +! Purpose: Sets estimated number of links and length of link names in a group. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! est_num_entries - Estimated number of links to be inserted into group +! est_name_len - Estimated average length of link names +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pset_est_link_info_f(gcpl_id, est_num_entries, est_name_len, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_est_link_info_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER, INTENT(IN) :: est_num_entries ! Estimated number of links to be inserted into group + INTEGER, INTENT(IN) :: est_name_len ! Estimated average length of link names + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_est_link_info_c(gcpl_id, est_num_entries, est_name_len) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_EST_LINK_INFO_C'::h5pset_est_link_info_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER, INTENT(IN) :: est_num_entries + INTEGER, INTENT(IN) :: est_name_len + END FUNCTION H5Pset_est_link_info_c + END INTERFACE + + hdferr = H5Pset_est_link_info_c(gcpl_id, est_num_entries, est_name_len) + + END SUBROUTINE H5Pset_est_link_info_f + +!---------------------------------------------------------------------- +! Name: H5Pset_link_phase_change_f +! +! Purpose: Sets the parameters for conversion between compact and dense groups. +! +! Inputs: +! gcpl_id - Group creation property list identifier +! max_compact - Maximum number of attributes to be stored in compact storage +! min_dense - Minimum number of attributes to be stored in dense storage +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_link_phase_change_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: gcpl_id ! Group creation property list identifier + INTEGER, INTENT(IN) :: max_compact ! Maximum number of attributes to be stored in compact storage + INTEGER, INTENT(IN) :: min_dense ! Minimum number of attributes to be stored in dense storage + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_link_phase_change_c(gcpl_id, max_compact, min_dense) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_LINK_PHASE_CHANGE_C'::h5pset_link_phase_change_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: gcpl_id + INTEGER, INTENT(IN) :: max_compact + INTEGER, INTENT(IN) :: min_dense + + END FUNCTION h5pset_link_phase_change_c + END INTERFACE + + hdferr = h5pset_link_phase_change_c(gcpl_id, max_compact, min_dense) + END SUBROUTINE h5pset_link_phase_change_f + +!---------------------------------------------------------------------- +! Name: H5Pset_fapl_direct_f +! +! Purpose: Sets up use of the direct I/O driver. +! +! Inputs: +! fapl_id - File access property list identifier +! alignment - Required memory alignment boundary +! block_size - File system block size +! cbuf_size - Copy buffer size +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pset_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_fapl_direct_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(IN) :: alignment ! Required memory alignment boundary! + INTEGER(SIZE_T), INTENT(IN) :: block_size ! File system block size + INTEGER(SIZE_T), INTENT(IN) :: cbuf_size ! Copy buffer size + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_fapl_direct_c(fapl_id, alignment, block_size, cbuf_size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_FAPL_DIRECT_C'::h5pset_fapl_direct_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: fapl_id + INTEGER(SIZE_T), INTENT(IN) :: alignment + INTEGER(SIZE_T), INTENT(IN) :: block_size + INTEGER(SIZE_T), INTENT(IN) :: cbuf_size + END FUNCTION H5Pset_fapl_direct_c + END INTERFACE + + hdferr = H5Pset_fapl_direct_c(fapl_id, alignment, block_size, cbuf_size) + END SUBROUTINE H5Pset_fapl_direct_f + +!---------------------------------------------------------------------- +! Name: H5Pget_fapl_direct_f +! +! Purpose: Gets up use of the direct I/O driver. +! +! Inputs: +! fapl_id - File access property list identifier +! Outputs: +! alignment - Required memory alignment boundary +! block_size - File system block size +! cbuf_size - Copy buffer size +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pget_fapl_direct_f(fapl_id, alignment, block_size, cbuf_size, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_fapl_direct_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(OUT) :: alignment ! Required memory alignment boundary! + INTEGER(SIZE_T), INTENT(OUT) :: block_size ! File system block size + INTEGER(SIZE_T), INTENT(OUT) :: cbuf_size ! Copy buffer size + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pget_fapl_direct_c(fapl_id, alignment, block_size, cbuf_size) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_FAPL_DIRECT_C'::h5pget_fapl_direct_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: fapl_id + INTEGER(SIZE_T), INTENT(OUT) :: alignment + INTEGER(SIZE_T), INTENT(OUT) :: block_size + INTEGER(SIZE_T), INTENT(OUT) :: cbuf_size + END FUNCTION H5Pget_fapl_direct_c + END INTERFACE + + hdferr = H5Pget_fapl_direct_c(fapl_id, alignment, block_size, cbuf_size) + END SUBROUTINE H5Pget_fapl_direct_f + +!---------------------------------------------------------------------- +! Name: H5Pset_attr_phase_change_f +! +! Purpose: Sets attribute storage phase change thresholds. +! +! Inputs: +! ocpl_id - Object (dataset or group) creation property list identifier +! Outputs: +! max_compact - Maximum number of attributes to be stored in compact storage +! (Default: 8) +! min_dense - Minimum number of attributes to be stored in dense storage +! (Default: 6) +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! January, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_attr_phase_change_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: ocpl_id ! Object (dataset or group) creation property list identifier + INTEGER, INTENT(IN) :: max_compact ! Maximum number of attributes to be stored in compact storage + !(Default: 8) + INTEGER, INTENT(IN) :: min_dense ! Minimum number of attributes to be stored in dense storage + ! (Default: 6) + INTEGER, INTENT(OUT) :: hdferr ! Error code +! +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_attr_phase_change_c(ocpl_id, max_compact, min_dense) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_ATTR_PHASE_CHANGE_C'::h5pset_attr_phase_change_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: ocpl_id + INTEGER, INTENT(IN) :: max_compact + INTEGER, INTENT(IN) :: min_dense + + END FUNCTION h5pset_attr_phase_change_c + END INTERFACE + + hdferr = h5pset_attr_phase_change_c(ocpl_id, max_compact, min_dense) + + + END SUBROUTINE h5pset_attr_phase_change_f + +!---------------------------------------------------------------------- +! Name: H5Pset_nbit_f +! +! Purpose: Sets up the use of the N-Bit filter. +! +! Inputs: +! plist_id - Dataset creation property list identifier. +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pset_nbit_f(plist_id, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_nbit_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_nbit_c(plist_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_NBIT_C'::h5pset_nbit_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + END FUNCTION H5Pset_nbit_c + END INTERFACE + + hdferr = H5Pset_nbit_c(plist_id) + + END SUBROUTINE H5Pset_nbit_f + +!---------------------------------------------------------------------- +! Name: H5Pset_scaleoffset_f +! +! Purpose: Sets up the use of the Scale-Offset filter. +! +! Inputs: +! plist_id - Dataset creation property list identifier. +! scale_type - Flag indicating compression method. +! scale_factor - Parameter related to scale. +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 21, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE H5Pset_scaleoffset_f(plist_id, scale_type, scale_factor, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_scaleoffset_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: plist_id ! Dataset creation property list identifier + INTEGER, INTENT(IN) :: scale_type ! Flag indicating compression method. + INTEGER, INTENT(IN) :: scale_factor ! parameter related to scale. + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION H5Pset_scaleoffset_c(plist_id, scale_type, scale_factor) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_SCALEOFFSET_C'::h5pset_scaleoffset_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: plist_id + INTEGER, INTENT(IN) :: scale_type + INTEGER, INTENT(IN) :: scale_factor + END FUNCTION H5Pset_scaleoffset_c + END INTERFACE + + hdferr = H5Pset_scaleoffset_c(plist_id, scale_type, scale_factor) + + END SUBROUTINE H5Pset_scaleoffset_f + +!---------------------------------------------------------------------- +! Name: h5pset_nlinks_f +! +! Purpose: Sets maximum number of soft or user-defined link traversals. +! +! Inputs: +! lapl_id - File access property list identifier +! nlinks - Maximum number of links to traverse +! +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 24, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pset_nlinks_f(lapl_id, nlinks, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pset_nlinks_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(IN) :: nlinks ! Maximum number of links to traverse + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pset_nlinks_c(lapl_id, nlinks) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PSET_NLINKS_C'::h5pset_nlinks_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: lapl_id + INTEGER(SIZE_T), INTENT(IN) :: nlinks + END FUNCTION h5pset_nlinks_c + END INTERFACE + + hdferr = h5pset_nlinks_c(lapl_id, nlinks) + + END SUBROUTINE h5pset_nlinks_f + +!---------------------------------------------------------------------- +! Name: h5pget_nlinks_f +! +! Purpose: Gets maximum number of soft or user-defined link traversals. +! +! Inputs: +! lapl_id - File access property list identifier +! nlinks - Maximum number of links to traverse +! +! Outputs: +! hdferr - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! March 24, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5pget_nlinks_f(lapl_id, nlinks, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_nlinks_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: lapl_id ! File access property list identifier + INTEGER(SIZE_T), INTENT(OUT) :: nlinks ! Maximum number of links to traverse + INTEGER, INTENT(OUT) :: hdferr ! Error code + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5pget_nlinks_c(lapl_id, nlinks) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_NLINKS_C'::h5pget_nlinks_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: lapl_id + INTEGER(SIZE_T), INTENT(OUT) :: nlinks + END FUNCTION h5pget_nlinks_c + END INTERFACE + + hdferr = h5pget_nlinks_c(lapl_id, nlinks) + + END SUBROUTINE h5pget_nlinks_f + +!---------------------------------------------------------------------- +! Name: H5Pget_create_inter_group_f +! +! Purpose: Determines whether property is set to enable creating missing intermediate groups. +! +! Inputs: +! lcpl_id - Link creation property list identifier +! crt_intermed_group - Specifying whether to create intermediate groups upon +! the creation of an object +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! April 4, 2008 +! +! Modifications: +! +! Comment: The long subroutine name (>31) on older f90 compilers causes problems +! so had to shorten the name +!-------------------------------------------------------------------------------------- + + SUBROUTINE h5pget_create_inter_group_f(lcpl_id, crt_intermed_group, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5pget_create_inter_group_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: lcpl_id ! Link creation property list identifier + INTEGER, INTENT(IN) :: crt_intermed_group ! Flag specifying whether to create intermediate groups + ! upon creation of an object + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTERFACE + INTEGER FUNCTION h5pget_create_inter_group_c(lcpl_id, crt_intermed_group) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5PGET_CREATE_INTER_GROUP_C'::h5pget_create_inter_group_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: lcpl_id + INTEGER(HID_T), INTENT(IN) :: crt_intermed_group + END FUNCTION h5pget_create_inter_group_c + END INTERFACE + + hdferr = h5pget_create_inter_group_c(lcpl_id, crt_intermed_group) + + END SUBROUTINE h5pget_create_inter_group_f + + +END MODULE H5P + diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c index 4430e1a..299f6bd 100644 --- a/fortran/src/H5Rf.c +++ b/fortran/src/H5Rf.c @@ -239,3 +239,102 @@ nh5rget_object_type_obj_c (hid_t_f *dset_id, haddr_t_f *ref, int_f *obj_type) return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5rget_name_object_c + * Purpose: Call H5Rget_name for an object + * Inputs: + * loc_id - Identifier for the dataset containing the reference or for the group that dataset is in. + * ref - An object or dataset region reference. + * + * Outputs: name - A name associated with the referenced object or dataset region. + * size - The size of the name buffer. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 31, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rget_name_object_c (hid_t_f *loc_id, haddr_t_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default) +{ + hobj_ref_t ref_c; + int_f ret_value = -1; + ssize_t c_size; + size_t c_bufsize; + char *c_buf= NULL; /* Buffer to hold C string */ + + ref_c = *ref; + + c_bufsize = (size_t)*name_len+1; + /* + * Allocate buffer to hold name of an attribute + */ + if ((c_buf = HDmalloc(c_bufsize)) == NULL) + return ret_value; + + /* + * Call H5Rget_name function. + */ + if((c_size=H5Rget_name((hid_t)*loc_id, H5R_OBJECT, &ref_c, c_buf, c_bufsize)) < 0) + return ret_value; + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HD5packFstring(c_buf, _fcdtocp(name), c_bufsize-1); + + *size_default = (size_t_f)c_size; + ret_value = 0; + if(c_buf) HDfree(c_buf); + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5rget_name_region_c + * Purpose: Call H5Rget_name for a dataset region + * Inputs: + * loc_id - Identifier for the dataset containing the reference or for the group that dataset is in. + * ref - An object or dataset region reference. + * + * Outputs: name - A name associated with the referenced object or dataset region. + * size - The size of the name buffer. + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 31, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5rget_name_region_c (hid_t_f *loc_id, int_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default) +{ + hdset_reg_ref_t ref_c; + int_f ret_value = -1; + ssize_t c_size; + size_t c_bufsize; + char *c_buf= NULL; /* Buffer to hold C string */ + + HDmemcpy (&ref_c, ref, H5R_DSET_REG_REF_BUF_SIZE); + + c_bufsize = (size_t)*name_len+1; + /* + * Allocate buffer to hold name of an attribute + */ + if ((c_buf = HDmalloc(c_bufsize)) == NULL) + return ret_value; + + /* + * Call H5Rget_name function. + */ + if((c_size=H5Rget_name((hid_t)*loc_id, H5R_DATASET_REGION, &ref_c, c_buf, c_bufsize)) < 0) + return ret_value; + /* + * Convert C name to FORTRAN and place it in the given buffer + */ + HD5packFstring(c_buf, _fcdtocp(name), c_bufsize-1); + + *size_default = (size_t_f)c_size; + ret_value = 0; + if(c_buf) HDfree(c_buf); + + return ret_value; +} diff --git a/fortran/src/H5Rff.f90 b/fortran/src/H5Rff.f90 index 6400f43..a4f4a65 100644 --- a/fortran/src/H5Rff.f90 +++ b/fortran/src/H5Rff.f90 @@ -58,6 +58,12 @@ END INTERFACE + INTERFACE h5rget_name_f + + MODULE PROCEDURE h5rget_name_object_f + MODULE PROCEDURE h5rget_name_region_f + + END INTERFACE CONTAINS @@ -243,7 +249,6 @@ INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object identifier INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER :: ref_type ! Reference type INTEGER(HADDR_T) :: ref_f ! Local buffer to pass reference ! INTEGER, EXTERNAL :: h5h5rdereference_object_c @@ -309,7 +314,6 @@ INTEGER(HID_T), INTENT(OUT) :: obj_id ! Dataspace identifier INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER :: ref_type ! Reference type INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference ! INTEGER, EXTERNAL :: h5rdereference_region_c @@ -328,7 +332,6 @@ END FUNCTION h5rdereference_region_c END INTERFACE - ref_type = H5R_DATASET_REGION_F ref_f = ref%ref hdferr = h5rdereference_region_c(dset_id, ref_f, obj_id ) @@ -475,4 +478,146 @@ END SUBROUTINE h5rget_object_type_obj_f - END MODULE H5R +!---------------------------------------------------------------------- +! Name: h5rget_name_object_f +! +! Purpose: Retrieves a name of a referenced object. +! +! Inputs: +! loc_id - Identifier for the dataset containing the reference or for the group that dataset is in. +! ref - An object or dataset region reference. +! +! Outputs: +! name - A name associated with the referenced object or dataset region. +! +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! size - The size of the name buffer. +! +! Programmer: M.S. Breitenfeld +! March 28, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + + SUBROUTINE h5rget_name_object_f(loc_id, ref, name, hdferr, size) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5rget_name_object_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for the dataset containing the reference + ! or for the group that dataset is in. + TYPE(hobj_ref_t_f), INTENT(IN) :: ref ! Object reference + INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size ! The size of the name buffer, + ! returning 0 (zero) if no name is associated with the identifier + CHARACTER(LEN=*), INTENT(OUT) :: name ! A name associated with the referenced object or dataset region. + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HADDR_T) :: ref_f ! Local buffer to pass reference + + INTEGER(SIZE_T) :: size_default + INTEGER(SIZE_T) :: name_len + + INTERFACE + INTEGER FUNCTION h5rget_name_object_c(loc_id, ref_f, name, name_len, size_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5RGET_NAME_OBJECT_C':: h5rget_name_object_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(SIZE_T) :: size_default + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER(HADDR_T) :: ref_f + + INTEGER(SIZE_T) :: name_len + END FUNCTION h5rget_name_object_c + END INTERFACE + + name_len=LEN(name) + + ref_f = ref%ref + hdferr = h5rget_name_object_c(loc_id, ref_f, name, name_len, size_default) + + IF(PRESENT(size)) size = size_default + + END SUBROUTINE h5rget_name_object_f + +!---------------------------------------------------------------------- +! Name: h5rget_name_region_f +! +! Purpose: Retrieves a name of a dataset region. +! +! Inputs: +! loc_id - Identifier for the dataset containing the reference or for the group that dataset is in. +! ref - An object or dataset region reference. +! +! Outputs: +! name - A name associated with the referenced object or dataset region. +! +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! size - The size of the name buffer. +! +! Programmer: M.S. Breitenfeld +! March 28, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + + SUBROUTINE h5rget_name_region_f(loc_id, ref, name, hdferr, size) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5rget_name_region_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! Identifier for the dataset containing the reference + ! or for the group that dataset is in. + TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Object reference + INTEGER(SIZE_T), OPTIONAL, INTENT(OUT) :: size ! The size of the name buffer, + ! returning 0 (zero) if no name is associated with the identifier + CHARACTER(LEN=*), INTENT(OUT) :: name ! A name associated with the referenced object or dataset region. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference + INTEGER(SIZE_T) :: size_default + INTEGER(SIZE_T) :: name_len + + INTERFACE + INTEGER FUNCTION h5rget_name_region_c(loc_id, ref_f, name, name_len, size_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5RGET_NAME_REGION_C':: h5rget_name_region_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(SIZE_T) :: size_default + CHARACTER(LEN=*), INTENT(OUT) :: name + INTEGER :: ref_f(REF_REG_BUF_LEN) + + INTEGER(SIZE_T) :: name_len + END FUNCTION h5rget_name_region_c + END INTERFACE + + name_len=LEN(name) + + ref_f = ref%ref + hdferr = h5rget_name_region_c(loc_id, ref_f, name, name_len, size_default) + + IF(PRESENT(size)) size = size_default + + END SUBROUTINE h5rget_name_region_f + +END MODULE H5R diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c index 0a4bd40..c33e7e6 100644 --- a/fortran/src/H5Sf.c +++ b/fortran/src/H5Sf.c @@ -1027,3 +1027,127 @@ nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hsi return ret_value; } +/*---------------------------------------------------------------------------- + * Name: h5sdecode_c + * Purpose: Call H5Sdecode + * Inputs: + * buf - Buffer for the data space object to be decoded. + * Outputs: + * obj_id - Object_id (non-negative) + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 26, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sdecode_c ( _fcd buf, int_f *obj_id ) +{ + int ret_value = -1; + unsigned char *c_buf = NULL; /* Buffer to hold C string */ + hid_t c_obj_id; + + /* + * Call H5Sdecode function. + */ + + c_buf = (unsigned char*)buf; + + c_obj_id = H5Sdecode(c_buf); + if(c_obj_id < 0) + return ret_value; + + *obj_id = (int_f)c_obj_id; + ret_value = 0; + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sencode_c + * Purpose: Call H5Sencode + * Inputs: + * obj_id - Identifier of the object to be encoded. + * buf - Buffer for the object to be encoded into. + * nalloc - The size of the allocated buffer. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * March 26, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) +{ + int ret_value = -1; + unsigned char *c_buf = NULL; /* Buffer to hold C string */ + size_t c_size; + + /* return just the size of the allocated buffer; + * equivalent to C routine for which 'name' is set equal to NULL + */ + + if (*nalloc == 0) { + + if(H5Sencode((hid_t)*obj_id, c_buf, &c_size) < 0) + return ret_value; + + *nalloc = (size_t_f)c_size; + + ret_value = 0; + return ret_value; + } + + c_size = (size_t)*nalloc; + /* + * Allocate buffer + */ + if ((c_buf = HDmalloc(c_size)) == NULL) + return ret_value; + /* + * Call H5Sencode function. + */ + if(H5Sencode((hid_t)*obj_id, c_buf, &c_size) < 0){ + return ret_value; + } + + /* copy the C buffer to the FORTRAN buffer. + * Can not use HD5packFstring because we don't want to + * eliminate the NUL terminator or pad remaining space + * with blanks. + */ + + HDmemcpy(_fcdtocp(buf),(char *)c_buf,c_size); + + ret_value = 0; + if(c_buf) HDfree(c_buf); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5sextent_equal_c + * Purpose: Call H5Sextent_equal + * Inputs: + * space1_id - First dataspace identifier. + * space2_id - Second dataspace identifier. + * Outputs: + * equal - TRUE if equal, FALSE if unequal. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 4, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5sextent_equal_c ( hid_t_f * space1_id, hid_t_f *space2_id, hid_t_f *c_equal) +{ + int ret_value = -1; + + if( (*c_equal = (hid_t_f)H5Sextent_equal((hid_t)*space1_id, (hid_t)*space2_id)) < 0) + return ret_value; + + ret_value = 0; + return ret_value; +} + diff --git a/fortran/src/H5Sff.f90 b/fortran/src/H5Sff.f90 index a4780c1..9e1367d 100644 --- a/fortran/src/H5Sff.f90 +++ b/fortran/src/H5Sff.f90 @@ -1942,4 +1942,170 @@ END SUBROUTINE h5sget_select_type_f - END MODULE H5S +!---------------------------------------------------------------------- +! Name: H5Sdecode_f +! +! Purpose: Decode a binary object description of data space and return a new object handle. +! +! Inputs: +! buf - Buffer for the data space object to be decoded. +! obj_id - Object ID +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Optional parameters: - NONE +! +! Programmer: M.S. Breitenfeld +! March 26, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5sdecode_f(buf, obj_id, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5sdecode_f +!DEC$endif +! + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: buf ! Buffer for the data space object to be decoded. + INTEGER, INTENT(OUT) :: obj_id ! Object ID + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTERFACE + INTEGER FUNCTION h5sdecode_c(buf, obj_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SDECODE_C'::h5sdecode_c + !DEC$ ENDIF + CHARACTER(LEN=*), INTENT(IN) :: buf + INTEGER, INTENT(OUT) :: obj_id ! Object ID + END FUNCTION h5sdecode_c + END INTERFACE + + hdferr = h5sdecode_c(buf, obj_id) + + END SUBROUTINE h5sdecode_f + +!---------------------------------------------------------------------- +! Name: H5Sencode_f +! +! Purpose: Encode a data space object description into a binary buffer. +! +! Inputs: +! obj_id - Identifier of the object to be encoded. +! buf - Buffer for the object to be encoded into. +! nalloc - The size of the allocated buffer. +! Outputs: +! nalloc - The size of the buffer needed. +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Optional parameters: - NONE +! +! Programmer: M.S. Breitenfeld +! March 26, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5sencode_f(obj_id, buf, nalloc, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5sencode_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Identifier of the object to be encoded. + CHARACTER(LEN=*), INTENT(OUT) :: buf ! Buffer for the object to be encoded into. + INTEGER(SIZE_T), INTENT(INOUT) :: nalloc ! The size of the allocated buffer. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + + INTERFACE + INTEGER FUNCTION h5sencode_c(buf, obj_id, nalloc) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SENCODE_C'::h5sencode_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(OUT) :: buf + INTEGER(SIZE_T), INTENT(INOUT) :: nalloc + END FUNCTION h5sencode_c + END INTERFACE + + hdferr = h5sencode_c(buf, obj_id, nalloc) + + END SUBROUTINE h5sencode_f + + +!---------------------------------------------------------------------- +! Name: h5sextent_equal_f +! +! Purpose: Determines whether two dataspace extents are equal. +! +! Inputs: +! space1_id - First dataspace identifier. +! space2_id - Second dataspace identifier. +! Outputs: +! Equal - .TRUE. if equal, .FALSE. if unequal. +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! April 2, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5sextent_equal_f(space1_id, space2_id, equal, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5sextent_equal_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space1_id ! First dataspace identifier. + INTEGER(HID_T), INTENT(IN) :: space2_id ! Second dataspace identifier. + LOGICAL, INTENT(OUT) :: Equal ! .TRUE. if equal, .FALSE. if unequal. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTEGER(HID_T) :: c_equal + + INTERFACE + INTEGER FUNCTION h5sextent_equal_c(space1_id, space2_id, c_equal) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SEXTENT_EQUAL_C'::h5sextent_equal_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: space1_id + INTEGER(HID_T), INTENT(IN) :: space2_id + INTEGER(HID_T) :: c_equal + END FUNCTION h5sextent_equal_c + END INTERFACE + + hdferr = h5sextent_equal_c(space1_id, space2_id, c_equal) + + + equal = .FALSE. + IF(c_equal.GT.0) equal = .TRUE. + + + END SUBROUTINE h5sextent_equal_f + +END MODULE H5S diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index 7c3befc..0ad0bc9 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -24,6 +24,7 @@ * Inputs: loc_id - file or group identifier * name - name of the datatype within file or group * namelen - name length + * tapl_id - datatype access property list identifier * Outputs: type_id - dataset identifier * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal @@ -31,7 +32,7 @@ * Modifications: *---------------------------------------------------------------------------*/ int_f -nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) +nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *tapl_id) { char *c_name = NULL; hid_t c_type_id; @@ -46,7 +47,7 @@ nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) /* * Call H5Topen2 function. */ - if((c_type_id = H5Topen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0) + if((c_type_id = H5Topen2((hid_t)*loc_id, c_name, (hid_t)*tapl_id)) < 0) goto done; *type_id = (hid_t_f)c_type_id; @@ -67,13 +68,19 @@ done: * name - name of the datatype within file or group * namelen - name length * type_id - dataset identifier + * lcpl_id - Link creation property list + * tcpl_id - Datatype creation property list + * tapl_id - Datatype access property list * Returns: 0 on success, -1 on failure * Programmer: Elena Pourmal * Saturday, August 14, 1999 * Modifications: + * - Added passing optional parameters for version 1.8 + * M.S. Breitenfeld *---------------------------------------------------------------------------*/ int_f -nh5tcommit_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) +nh5tcommit_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, + hid_t_f *lcpl_id, hid_t_f *tcpl_id, hid_t_f *tapl_id) { char *c_name = NULL; int ret_value = -1; @@ -83,7 +90,7 @@ nh5tcommit_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id) goto done; /* Call H5Tcommit2 function */ - if(H5Tcommit2((hid_t)*loc_id, c_name, (hid_t)*type_id, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) + if(H5Tcommit2((hid_t)*loc_id, c_name, (hid_t)*type_id, (hid_t)*lcpl_id, (hid_t)*tcpl_id, (hid_t)*tapl_id) < 0) goto done; ret_value = 0; @@ -1634,3 +1641,202 @@ nh5tget_member_class_c ( hid_t_f *type_id , int_f *member_no, int_f *class ) *class = (int_f)c_class; return ret_value; } + +/*---------------------------------------------------------------------------- + * Name: h5tcommit_anon_c + * Purpose: Call H5Tcommit_anon + * Inputs: loc_id - file or group identifier + * dtype_id - dataset identifier + * tcpl_id - Datatype creation property list + * tapl_id - Datatype access property list + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * February 25, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tcommit_anon_c(hid_t_f *loc_id, hid_t_f *dtype_id, + hid_t_f *tcpl_id, hid_t_f *tapl_id) +{ + int ret_value = -1; + + /* Call H5Tcommit_anon function */ + if(H5Tcommit_anon((hid_t)*loc_id, (hid_t)*dtype_id, (hid_t)*tcpl_id, (hid_t)*tapl_id) < 0) + goto done; + + ret_value = 0; + + done: + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tcommitted_c + * Purpose: Call H5Tcommitted + * dtype_id - dataset identifier + * Returns: a positive value, for TRUE, if the datatype has been committed, + * or 0 (zero), for FALSE, if the datatype has not been committed. + * Otherwise returns a negative value. + * Programmer: M.S. Breitenfeld + * February 25, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ +int_f +nh5tcommitted_c(hid_t_f *dtype_id) +{ + int_f ret_value; + + /* Call H5Tcommitted function */ + + ret_value=(int_f)H5Tcommitted((hid_t)*dtype_id); + + return ret_value; + +} + +/*---------------------------------------------------------------------------- + * Name: h5tdecode_c + * Purpose: Call H5Tdecode + * Inputs: + * buf - Buffer for the data space object to be decoded. + * Outputs: + * obj_id - Object_id (non-negative) + * + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 9, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tdecode_c ( _fcd buf, int_f *obj_id ) +{ + int ret_value = -1; + unsigned char *c_buf = NULL; /* Buffer to hold C string */ + hid_t c_obj_id; + + /* + * Call H5Tdecode function. + */ + + c_buf = (unsigned char*)buf; + + c_obj_id = H5Tdecode(c_buf); + if(c_obj_id < 0) + return ret_value; + + *obj_id = (int_f)c_obj_id; + ret_value = 0; + + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tencode_c + * Purpose: Call H5Tencode + * Inputs: + * obj_id - Identifier of the object to be encoded. + * buf - Buffer for the object to be encoded into. + * nalloc - The size of the allocated buffer. + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 9, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ) +{ + int ret_value = -1; + unsigned char *c_buf = NULL; /* Buffer to hold C string */ + size_t c_size; + + /* return just the size of the allocated buffer; + * equivalent to C routine for which 'name' is set equal to NULL + */ + + if (*nalloc == 0) { + + if(H5Tencode((hid_t)*obj_id, c_buf, &c_size) < 0) + return ret_value; + + *nalloc = (size_t_f)c_size; + + ret_value = 0; + return ret_value; + } + + c_size = (size_t)*nalloc; + /* + * Allocate buffer + */ + if ((c_buf = HDmalloc(c_size)) == NULL) + return ret_value; + /* + * Call H5Tencode function. + */ + if(H5Tencode((hid_t)*obj_id, c_buf, &c_size) < 0){ + return ret_value; + } + + /* copy the C buffer to the FORTRAN buffer. + * Can not use HD5packFstring because we don't want to + * eliminate the NUL terminator or pad remaining space + * with blanks. + */ + + HDmemcpy(_fcdtocp(buf),(char *)c_buf,c_size); + + ret_value = 0; + if(c_buf) HDfree(c_buf); + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tget_create_plist_c + * Purpose: Call H5Tget_create_plist + * Inputs: dtype_id - Datatype identifier + * Outputs: dtpl_id - Datatype property list identifier + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 9, 2008 + * Modifications: N/A + *---------------------------------------------------------------------------*/ + +int_f +nh5tget_create_plist_c ( hid_t_f *dtype_id, hid_t_f *dtpl_id) +{ + int_f ret_value=-1; /* Return value */ + + if ((*dtpl_id = (hid_t_f)H5Tget_create_plist((hid_t)*dtype_id)) < 0) + return ret_value; + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5tcompiler_conv_c + * Purpose: Call H5Tcompiler_conv + * Inputs: + * src_id - Identifier for the source datatype. + * dst_id - Identifier for the destination datatype. + * Outputs: c_flag - flag; TRUE for compiler conversion, FALSE for library conversion + * Returns: 0 on success, -1 on failure + * Programmer: M.S. Breitenfeld + * April 9, 2008 + * Modifications: + *---------------------------------------------------------------------------*/ + +int_f +nh5tcompiler_conv_c ( hid_t_f *src_id, hid_t_f *dst_id, int_f *c_flag) +{ + int ret_value = -1; + htri_t status; + + status = H5Tcompiler_conv( (hid_t)*src_id , (hid_t)*dst_id); + if ( status < 0 ) return ret_value; + *c_flag = (int_f)status; + ret_value = 0; + return ret_value; +} diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90 index ee5bb77..dee6990 100644 --- a/fortran/src/H5Tff.f90 +++ b/fortran/src/H5Tff.f90 @@ -16,11 +16,11 @@ ! ! This file contains FORTRAN90 interfaces for H5T functions ! - MODULE H5T +MODULE H5T - USE H5GLOBAL + USE H5GLOBAL - CONTAINS +CONTAINS !---------------------------------------------------------------------- ! Name: h5topen_f @@ -36,53 +36,62 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! NONE +! tapl_id - datatype access property list identifier. ! ! Programmer: Elena Pourmal ! August 12, 1999 ! -! Modifications: Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). March 7, 2001 +! Modifications: Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! +! Added optional parameter 'tapl_id' for compatability +! with H5Topen2. April 9, 2009. ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr) + SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr, tapl_id) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5topen_f !DEC$endif ! - 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 + 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(HID_T), OPTIONAL, INTENT(IN) :: tapl_id ! datatype access property list identifier -! INTEGER, EXTERNAL :: h5topen_c + INTEGER :: namelen ! Name length + INTEGER(HID_T) :: tapl_id_default +! ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5topen_c(loc_id, name, namelen, type_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TOPEN_C'::h5topen_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference ::name - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(OUT) :: type_id - END FUNCTION h5topen_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5topen_c(loc_id, name, namelen, type_id) - END SUBROUTINE h5topen_f + INTERFACE + INTEGER FUNCTION h5topen_c(loc_id, name, namelen, type_id, tapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TOPEN_C'::h5topen_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference ::name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(OUT) :: type_id + INTEGER(HID_T) :: tapl_id_default + END FUNCTION h5topen_c + END INTERFACE + + namelen = LEN(name) + + tapl_id_default = H5P_DEFAULT_F + IF(PRESENT(tapl_id)) tapl_id_default = tapl_id + + hdferr = h5topen_c(loc_id, name, namelen, type_id, tapl_id_default) + END SUBROUTINE h5topen_f !---------------------------------------------------------------------- ! Name: h5tcommit_f @@ -100,53 +109,84 @@ ! Success: 0 ! Failure: -1 ! Optional parameters: -! NONE +! lcpl_id - Link creation property list +! tcpl_id - Datatype creation property list +! tapl_id - Datatype access property list ! ! Programmer: Elena Pourmal ! August 12, 1999 ! -! Modifications: Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). March 7, 2001 +! Modifications: - Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! +! - Added optional parameters introduced in version 1.8 +! M.S. Breitenfeld +! +! ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5tcommit_f(loc_id, name, type_id, hdferr) + SUBROUTINE h5tcommit_f(loc_id, name, type_id, hdferr, & + lcpl_id, tcpl_id, tapl_id ) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5tcommit_f !DEC$endif ! - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier - CHARACTER(LEN=*), INTENT(IN) :: name + 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(HID_T), INTENT(IN) :: type_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: lcpl_id ! Link creation property list + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tcpl_id ! Datatype creation property list + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tapl_id ! Datatype access property list + + + INTEGER :: namelen ! Name length + + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: tcpl_id_default + INTEGER(HID_T) :: tapl_id_default -! INTEGER, EXTERNAL :: h5tcommit_c ! MS FORTRAN needs explicit interface for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5tcommit_c(loc_id, name, namelen, type_id) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TCOMMIT_C'::h5tcommit_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference ::name - INTEGER(HID_T), INTENT(IN) :: loc_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER :: namelen - INTEGER(HID_T), INTENT(IN) :: type_id - END FUNCTION h5tcommit_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5tcommit_c(loc_id, name, namelen, type_id) - END SUBROUTINE h5tcommit_f + INTERFACE + INTEGER FUNCTION h5tcommit_c(loc_id, name, namelen, type_id, & + lcpl_id_default, tcpl_id_default, tapl_id_default ) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TCOMMIT_C'::h5tcommit_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference ::name + INTEGER(HID_T), INTENT(IN) :: loc_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER :: namelen + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER(HID_T) :: lcpl_id_default + INTEGER(HID_T) :: tcpl_id_default + INTEGER(HID_T) :: tapl_id_default + END FUNCTION h5tcommit_c + END INTERFACE + + lcpl_id_default = H5P_DEFAULT_F + tcpl_id_default = H5P_DEFAULT_F + tapl_id_default = H5P_DEFAULT_F + + IF (PRESENT(lcpl_id)) lcpl_id_default = lcpl_id + IF (PRESENT(tcpl_id)) tcpl_id_default = tcpl_id + IF (PRESENT(tapl_id)) tapl_id_default = tapl_id + + namelen = LEN(name) + + hdferr = h5tcommit_c(loc_id, name, namelen, type_id, & + lcpl_id_default, tcpl_id_default, tapl_id_default ) + + END SUBROUTINE h5tcommit_f !---------------------------------------------------------------------- ! Name: h5tcopy_f @@ -3249,4 +3289,357 @@ END SUBROUTINE h5tget_member_class_f !---------------------------------------------------------------------- - END MODULE H5T +! Name: h5tcommit_anon_f +! +! Purpose: Commits a transient datatype to a file, +! creating a new named datatype, +! but does not link it into the file structure. +! +! Inputs: +! loc_id - A file or group identifier specifying the file +! in which the new named datatype is to be created. +! dtype_id - A datatype identifier. +! +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! tcpl_id - A datatype creation property list identifier. +! (H5P_DEFAULT_F for the default property list.) +! tapl_id - A datatype access property list identifier. +! should always be passed as the value H5P_DEFAULT_F. +! +! Programmer: M.S. Breitenfeld +! February 25, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5tcommit_anon_f(loc_id, dtype_id, hdferr, tcpl_id, tapl_id) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tcommit_anon_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: loc_id ! A file or group identifier specifying + ! the file in which the new named datatype + ! is to be created. + INTEGER(HID_T), INTENT(IN) :: dtype_id ! Datatype identifier + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tcpl_id ! A datatype creation property + ! list identifier. + ! (H5P_DEFAULT_F for the default property list.) + INTEGER(HID_T), OPTIONAL, INTENT(IN) :: tapl_id ! A datatype access property list identifier. + ! should always be passed as the value H5P_DEFAULT_F. + INTEGER(HID_T) :: tcpl_id_default + INTEGER(HID_T) :: tapl_id_default + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5tcommit_anon_c(loc_id, dtype_id, & + tcpl_id_default, tapl_id_default) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TCOMMIT_ANON_C'::h5tcommit_anon_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference ::name + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER(HID_T), INTENT(IN) :: dtype_id + INTEGER(HID_T) :: tcpl_id_default + INTEGER(HID_T) :: tapl_id_default + END FUNCTION h5tcommit_anon_c + END INTERFACE + + tcpl_id_default = H5P_DEFAULT_F + tapl_id_default = H5P_DEFAULT_F + + IF(PRESENT(tcpl_id)) tcpl_id_default = tcpl_id + IF(PRESENT(tapl_id)) tapl_id_default = tapl_id + + hdferr = h5tcommit_anon_c(loc_id, dtype_id, & + tcpl_id_default, tapl_id_default ) + + END SUBROUTINE h5tcommit_anon_f + +!---------------------------------------------------------------------- +! Name: h5tcommitted_f +! +! Purpose: Determines whether a datatype is a named type or a transient type. +! +! Inputs: +! dtype_id - A datatype identifier. +! +! Outputs: +! committed - .TRUE., if the datatype has been committed +! .FALSE., if the datatype has not been committed. +! hdferr: - error code +! Success: 0 +! Failure: -1 +! Optional parameters: None +! +! Programmer: M.S. Breitenfeld +! February 25, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5tcommitted_f(dtype_id, committed, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tcommitted_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dtype_id ! A datatype identifier + LOGICAL, INTENT(OUT) :: committed ! .TRUE., if the datatype has been committed + !.FALSE., if the datatype has not been committed. + INTEGER, INTENT(OUT) :: hdferr ! Error code: +! Success: 0 +! Failure: -1 + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5tcommitted_c(dtype_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TCOMMITTED_C'::h5tcommitted_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference ::name + INTEGER(HID_T), INTENT(IN) :: dtype_id + END FUNCTION h5tcommitted_c + END INTERFACE + + hdferr = h5tcommitted_c(dtype_id) + + IF(hdferr.GT.0)THEN + committed = .TRUE. + hdferr = 0 + ELSE IF(hdferr.EQ.0)THEN + committed = .FALSE. + hdferr = 0 + ELSE + hdferr = -1 + ENDIF + + + END SUBROUTINE h5tcommitted_f + +!---------------------------------------------------------------------- +! Name: H5Tdecode_f +! +! Purpose: Decode a binary object description of data type and return a new object handle. +! Inputs: +! buf - Buffer for the data space object to be decoded. +! obj_id - Object ID +! Outputs: +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Optional parameters: - NONE +! +! Programmer: M.S. Breitenfeld +! April 9, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5tdecode_f(buf, obj_id, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tdecode_f +!DEC$endif +! + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: buf ! Buffer for the data space object to be decoded. + INTEGER, INTENT(OUT) :: obj_id ! Object ID + INTEGER, INTENT(OUT) :: hdferr ! Error code + + INTERFACE + INTEGER FUNCTION h5tdecode_c(buf, obj_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TDECODE_C'::h5tdecode_c + !DEC$ ENDIF + CHARACTER(LEN=*), INTENT(IN) :: buf + INTEGER, INTENT(OUT) :: obj_id ! Object ID + END FUNCTION h5tdecode_c + END INTERFACE + + hdferr = h5tdecode_c(buf, obj_id) + + END SUBROUTINE h5tdecode_f + +!---------------------------------------------------------------------- +! Name: H5Tencode_f +! +! Purpose: Encode a data type object description into a binary buffer. +! +! Inputs: +! obj_id - Identifier of the object to be encoded. +! buf - Buffer for the object to be encoded into. +! nalloc - The size of the allocated buffer. +! Outputs: +! nalloc - The size of the buffer needed. +! hdferr: - error code +! Success: 0 +! Failure: -1 +! +! Optional parameters: - NONE +! +! Programmer: M.S. Breitenfeld +! April 9, 2008 +! +! Modifications: +! +! Comment: +!---------------------------------------------------------------------- + + SUBROUTINE h5tencode_f(obj_id, buf, nalloc, hdferr) +! +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tencode_f +!DEC$endif +! + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: obj_id ! Identifier of the object to be encoded. + CHARACTER(LEN=*), INTENT(OUT) :: buf ! Buffer for the object to be encoded into. + INTEGER(SIZE_T), INTENT(INOUT) :: nalloc ! The size of the allocated buffer. + INTEGER, INTENT(OUT) :: hdferr ! Error code + + + INTERFACE + INTEGER FUNCTION h5tencode_c(buf, obj_id, nalloc) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TENCODE_C'::h5tencode_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: obj_id + CHARACTER(LEN=*), INTENT(OUT) :: buf + INTEGER(SIZE_T), INTENT(INOUT) :: nalloc + END FUNCTION h5tencode_c + END INTERFACE + + hdferr = h5tencode_c(buf, obj_id, nalloc) + + END SUBROUTINE h5tencode_f + +!---------------------------------------------------------------------- +! Name: h5tget_create_plist_f +! +! Purpose: Returns a copy of a datatype creation property list. +! +! Inputs: +! dtype_id - Datatype identifier +! Outputs: +! dtpl_id - Datatype property list identifier +! hdferr: - Error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! April 9, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5tget_create_plist_f(dtype_id, dtpl_id, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tget_create_plist_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dtype_id ! Datatype identifier + INTEGER(HID_T), INTENT(OUT) :: dtpl_id ! Datatype property list identifier. + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + +! MS FORTRAN needs explicit interface for C functions called here. +! + INTERFACE + INTEGER FUNCTION h5tget_create_plist_c(dtype_id, dtpl_id) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TGET_CREATE_PLIST_C'::h5tget_create_plist_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: dtype_id + INTEGER(HID_T), INTENT(OUT) :: dtpl_id + END FUNCTION h5tget_create_plist_c + END INTERFACE + + hdferr = h5tget_create_plist_c(dtype_id, dtpl_id) + END SUBROUTINE h5tget_create_plist_f + +!---------------------------------------------------------------------- +! Name: h5tcompiler_conv_f +! +! Purpose: Check whether the library’s default conversion is hard conversion.R +! +! Inputs: +! src_id - Identifier for the source datatype. +! dst_id - Identifier for the destination datatype. +! Outputs: +! flag - TRUE for compiler conversion, FALSE for library conversion +! hdferr: - Error code +! Success: 0 +! Failure: -1 +! Optional parameters: +! NONE +! +! Programmer: M.S. Breitenfeld +! April 9, 2008 +! +! Modifications: N/A +! +!---------------------------------------------------------------------- + + SUBROUTINE h5tcompiler_conv_f( src_id, dst_id, flag, hdferr) +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: h5tcompiler_conv_f +!DEC$endif + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: src_id ! Identifier for the source datatype. + INTEGER(HID_T), INTENT(IN) :: dst_id ! Identifier for the destination datatype. + LOGICAL, INTENT(OUT) :: flag ! .TRUE. for compiler conversion, .FALSE. for library conversion + INTEGER, INTENT(OUT) :: hdferr ! Error code: + ! 0 on success and -1 on failure + INTEGER :: c_flag + + INTERFACE + INTEGER FUNCTION h5tcompiler_conv_c(src_id, dst_id, c_flag) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5TCOMPILER_CONV_C'::h5tcompiler_conv_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: src_id + INTEGER(HID_T), INTENT(IN) :: dst_id + INTEGER :: c_flag + END FUNCTION h5tcompiler_conv_c + END INTERFACE + + hdferr = h5tcompiler_conv_c(src_id, dst_id, c_flag) + + flag = .FALSE. + IF(c_flag .GT. 0) flag = .TRUE. + + END SUBROUTINE h5tcompiler_conv_f + +END MODULE H5T diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c index a9ac279..77240b2 100644 --- a/fortran/src/H5_f.c +++ b/fortran/src/H5_f.c @@ -215,213 +215,310 @@ nh5close_types_c( hid_t_f * types, int_f *lentypes, * Added more FD flags and new H5LIB flags * Added more FD flags for HDF5 file driver * EIP, April 9, 2005 + * Added Generic flags introduced in version 1.8 + * MSB, January, 2008 + * Added types in lines h5*_flags = ( )variable to match input *---------------------------------------------------------------------------*/ int_f nh5init_flags_c( int_f *h5d_flags, int_f *h5f_flags, int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, - int_f *h5g_flags, int_f *h5i_flags, + int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, hid_t_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, - int_f *h5t_flags, int_f *h5z_flags) + int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags) { int ret_value = -1; /* * H5D flags */ - h5d_flags[0] = H5D_COMPACT; - h5d_flags[1] = H5D_CONTIGUOUS; - h5d_flags[2] = H5D_CHUNKED; - h5d_flags[3] = H5D_ALLOC_TIME_ERROR; - h5d_flags[4] = H5D_ALLOC_TIME_DEFAULT; - h5d_flags[5] = H5D_ALLOC_TIME_EARLY; - h5d_flags[6] = H5D_ALLOC_TIME_LATE; - h5d_flags[7] = H5D_ALLOC_TIME_INCR; - h5d_flags[8] = H5D_SPACE_STATUS_ERROR; - h5d_flags[9] = H5D_SPACE_STATUS_NOT_ALLOCATED; - h5d_flags[10] = H5D_SPACE_STATUS_PART_ALLOCATED; - h5d_flags[11] = H5D_SPACE_STATUS_ALLOCATED; - h5d_flags[12] = H5D_FILL_TIME_ERROR; - h5d_flags[13] = H5D_FILL_TIME_ALLOC; - h5d_flags[14] = H5D_FILL_TIME_NEVER; - h5d_flags[15] = H5D_FILL_VALUE_ERROR; - h5d_flags[16] = H5D_FILL_VALUE_UNDEFINED; - h5d_flags[17] = H5D_FILL_VALUE_DEFAULT; - h5d_flags[18] = H5D_FILL_VALUE_USER_DEFINED; + h5d_flags[0] = (int_f)H5D_COMPACT; + h5d_flags[1] = (int_f)H5D_CONTIGUOUS; + h5d_flags[2] = (int_f)H5D_CHUNKED; + h5d_flags[3] = (int_f)H5D_ALLOC_TIME_ERROR; + h5d_flags[4] = (int_f)H5D_ALLOC_TIME_DEFAULT; + h5d_flags[5] = (int_f)H5D_ALLOC_TIME_EARLY; + h5d_flags[6] = (int_f)H5D_ALLOC_TIME_LATE; + h5d_flags[7] = (int_f)H5D_ALLOC_TIME_INCR; + h5d_flags[8] = (int_f)H5D_SPACE_STATUS_ERROR; + h5d_flags[9] = (int_f)H5D_SPACE_STATUS_NOT_ALLOCATED; + h5d_flags[10] = (int_f)H5D_SPACE_STATUS_PART_ALLOCATED; + h5d_flags[11] = (int_f)H5D_SPACE_STATUS_ALLOCATED; + h5d_flags[12] = (int_f)H5D_FILL_TIME_ERROR; + h5d_flags[13] = (int_f)H5D_FILL_TIME_ALLOC; + h5d_flags[14] = (int_f)H5D_FILL_TIME_NEVER; + h5d_flags[15] = (int_f)H5D_FILL_VALUE_ERROR; + h5d_flags[16] = (int_f)H5D_FILL_VALUE_UNDEFINED; + h5d_flags[17] = (int_f)H5D_FILL_VALUE_DEFAULT; + h5d_flags[18] = (int_f)H5D_FILL_VALUE_USER_DEFINED; /* * H5F flags */ - h5f_flags[0] = (int_f)H5F_ACC_RDWR; - h5f_flags[1] = (int_f)H5F_ACC_RDONLY; - h5f_flags[2] = (int_f)H5F_ACC_TRUNC; - h5f_flags[3] = (int_f)H5F_ACC_EXCL; - h5f_flags[4] = (int_f)H5F_ACC_DEBUG; - h5f_flags[5] = (int_f)H5F_SCOPE_LOCAL; - h5f_flags[6] = (int_f)H5F_SCOPE_GLOBAL; - h5f_flags[7] = (int_f)H5F_CLOSE_DEFAULT; - h5f_flags[8] = (int_f)H5F_CLOSE_WEAK; - h5f_flags[9] = (int_f)H5F_CLOSE_SEMI; - h5f_flags[10] = (int_f)H5F_CLOSE_STRONG; - h5f_flags[11] = (int_f)H5F_OBJ_FILE; - h5f_flags[12] = (int_f)H5F_OBJ_DATASET; - h5f_flags[13] = (int_f)H5F_OBJ_GROUP; - h5f_flags[14] = (int_f)H5F_OBJ_DATATYPE; - h5f_flags[15] = (int_f)H5F_OBJ_ALL; - + h5f_flags[0] = (int_f)H5F_ACC_RDWR; + h5f_flags[1] = (int_f)H5F_ACC_RDONLY; + h5f_flags[2] = (int_f)H5F_ACC_TRUNC; + h5f_flags[3] = (int_f)H5F_ACC_EXCL; + h5f_flags[4] = (int_f)H5F_ACC_DEBUG; + h5f_flags[5] = (int_f)H5F_SCOPE_LOCAL; + h5f_flags[6] = (int_f)H5F_SCOPE_GLOBAL; + h5f_flags[7] = (int_f)H5F_CLOSE_DEFAULT; + h5f_flags[8] = (int_f)H5F_CLOSE_WEAK; + h5f_flags[9] = (int_f)H5F_CLOSE_SEMI; + h5f_flags[10] = (int_f)H5F_CLOSE_STRONG; + h5f_flags[11] = (int_f)H5F_OBJ_FILE; + h5f_flags[12] = (int_f)H5F_OBJ_DATASET; + h5f_flags[13] = (int_f)H5F_OBJ_GROUP; + h5f_flags[14] = (int_f)H5F_OBJ_DATATYPE; + h5f_flags[15] = (int_f)H5F_OBJ_ALL; + h5f_flags[16] = (int_f)H5F_LIBVER_EARLIEST; + h5f_flags[17] = (int_f)H5F_LIBVER_LATEST; + /* * H5FD flags */ - h5fd_flags[0] = H5FD_MPIO_INDEPENDENT; - h5fd_flags[1] = H5FD_MPIO_COLLECTIVE; - h5fd_flags[2] = H5FD_MEM_NOLIST; - h5fd_flags[3] = H5FD_MEM_DEFAULT; - h5fd_flags[4] = H5FD_MEM_SUPER; - h5fd_flags[5] = H5FD_MEM_BTREE; - h5fd_flags[6] = H5FD_MEM_DRAW; - h5fd_flags[7] = H5FD_MEM_GHEAP; - h5fd_flags[8] = H5FD_MEM_LHEAP; - h5fd_flags[9] = H5FD_MEM_OHDR; - h5fd_flags[10] = H5FD_MEM_NTYPES; + h5fd_flags[0] = (int_f)H5FD_MPIO_INDEPENDENT; + h5fd_flags[1] = (int_f)H5FD_MPIO_COLLECTIVE; + h5fd_flags[2] = (int_f)H5FD_MEM_NOLIST; + h5fd_flags[3] = (int_f)H5FD_MEM_DEFAULT; + h5fd_flags[4] = (int_f)H5FD_MEM_SUPER; + h5fd_flags[5] = (int_f)H5FD_MEM_BTREE; + h5fd_flags[6] = (int_f)H5FD_MEM_DRAW; + h5fd_flags[7] = (int_f)H5FD_MEM_GHEAP; + h5fd_flags[8] = (int_f)H5FD_MEM_LHEAP; + h5fd_flags[9] = (int_f)H5FD_MEM_OHDR; + h5fd_flags[10] = (int_f)H5FD_MEM_NTYPES; /* * H5FD flags of type hid_t */ - h5fd_hid_flags[0] = H5FD_CORE; - h5fd_hid_flags[1] = H5FD_FAMILY; - h5fd_hid_flags[2] = H5FD_LOG; - h5fd_hid_flags[3] = H5FD_MPIO; - h5fd_hid_flags[4] = H5FD_MULTI; - h5fd_hid_flags[5] = H5FD_SEC2; - h5fd_hid_flags[6] = H5FD_STDIO; + h5fd_hid_flags[0] = (int_f)H5FD_CORE; + h5fd_hid_flags[1] = (int_f)H5FD_FAMILY; + h5fd_hid_flags[2] = (int_f)H5FD_LOG; + h5fd_hid_flags[3] = (int_f)H5FD_MPIO; + h5fd_hid_flags[4] = (int_f)H5FD_MULTI; + h5fd_hid_flags[5] = (int_f)H5FD_SEC2; + h5fd_hid_flags[6] = (int_f)H5FD_STDIO; /* * H5G flags */ - h5g_flags[0] = H5O_TYPE_UNKNOWN; - h5g_flags[1] = H5O_TYPE_GROUP; - h5g_flags[2] = H5O_TYPE_DATASET; - h5g_flags[3] = H5O_TYPE_NAMED_DATATYPE; + h5g_flags[0] = (int_f)H5O_TYPE_UNKNOWN; + h5g_flags[1] = (int_f)H5O_TYPE_GROUP; + h5g_flags[2] = (int_f)H5O_TYPE_DATASET; + h5g_flags[3] = (int_f)H5O_TYPE_NAMED_DATATYPE; /* This value can no longer be returned and all these flags should be updated * to reflect the refinements between links and objects. -QAK */ -/* h5g_flags[4] = H5G_LINK; */ - h5g_flags[5] = H5L_TYPE_ERROR; - h5g_flags[6] = H5L_TYPE_HARD; - h5g_flags[7] = H5L_TYPE_SOFT; +/* h5g_flags[4] = H5G_LINK; */ + h5g_flags[5] = (int_f)H5L_TYPE_ERROR; + h5g_flags[6] = (int_f)H5L_TYPE_HARD; + h5g_flags[7] = (int_f)H5L_TYPE_SOFT; + + h5g_flags[8] = (int_f)H5G_STORAGE_TYPE_UNKNOWN; + h5g_flags[9] = (int_f)H5G_STORAGE_TYPE_SYMBOL_TABLE; + h5g_flags[10] = (int_f)H5G_STORAGE_TYPE_COMPACT; + h5g_flags[11] = (int_f)H5G_STORAGE_TYPE_DENSE; /* * H5I flags */ - h5i_flags[0] = H5I_FILE; - h5i_flags[1] = H5I_GROUP; - h5i_flags[2] = H5I_DATATYPE; - h5i_flags[3] = H5I_DATASPACE; - h5i_flags[4] = H5I_DATASET; - h5i_flags[5] = H5I_ATTR; - h5i_flags[6] = H5I_BADID; + h5i_flags[0] = (int_f)H5I_FILE; + h5i_flags[1] = (int_f)H5I_GROUP; + h5i_flags[2] = (int_f)H5I_DATATYPE; + h5i_flags[3] = (int_f)H5I_DATASPACE; + h5i_flags[4] = (int_f)H5I_DATASET; + h5i_flags[5] = (int_f)H5I_ATTR; + h5i_flags[6] = (int_f)H5I_BADID; +/* + * H5L flags + */ + h5l_flags[0] = (int_f)H5L_TYPE_ERROR; + h5l_flags[1] = (int_f)H5L_TYPE_HARD; + h5l_flags[2] = (int_f)H5L_TYPE_SOFT; + h5l_flags[3] = (int_f)H5L_TYPE_EXTERNAL; + h5l_flags[4] = (int_f)H5L_SAME_LOC; /* Macro to indicate operation occurs on same location */ + h5l_flags[5] = (int_f)H5L_LINK_CLASS_T_VERS; /* Current version of the H5L_class_t struct */ + +/* + * H5O flags + */ + +/* Flags for object copy (H5Ocopy) */ + h5o_flags[0] = (int_f)H5O_COPY_SHALLOW_HIERARCHY_FLAG; /* Copy only immediate members */ + h5o_flags[1] = (int_f)H5O_COPY_EXPAND_SOFT_LINK_FLAG; /* Expand soft links into new objects */ + h5o_flags[2] = (int_f)H5O_COPY_EXPAND_EXT_LINK_FLAG; /* Expand external links into new objects */ + h5o_flags[3] = (int_f)H5O_COPY_EXPAND_REFERENCE_FLAG; /* Copy objects that are pointed by references */ + h5o_flags[4] = (int_f)H5O_COPY_WITHOUT_ATTR_FLAG; /* Copy object without copying attributes */ + h5o_flags[5] = (int_f)H5O_COPY_PRESERVE_NULL_FLAG; /* Copy NULL messages (empty space) */ + h5o_flags[6] = (int_f)H5O_COPY_ALL; /* All object copying flags (for internal checking) */ + +/* Flags for shared message indexes. + * Pass these flags in using the mesg_type_flags parameter in + * H5P_set_shared_mesg_index. + * (Developers: These flags correspond to object header message type IDs, + * but we need to assign each kind of message to a different bit so that + * one index can hold multiple types.) + */ + h5o_flags[7] = (int_f)H5O_SHMESG_NONE_FLAG; /* No shared messages */ + h5o_flags[8] = (int_f)H5O_SHMESG_SDSPACE_FLAG; /* Simple Dataspace Message. */ + h5o_flags[9] = (int_f)H5O_SHMESG_DTYPE_FLAG; /* Datatype Message. */ + h5o_flags[10] = (int_f)H5O_SHMESG_FILL_FLAG; /* Fill Value Message. */ + h5o_flags[11] = (int_f)H5O_SHMESG_PLINE_FLAG; /* Filter pipeline message. */ + h5o_flags[12] = (int_f)H5O_SHMESG_ATTR_FLAG; /* Attribute Message. */ + h5o_flags[13] = (int_f)H5O_SHMESG_ALL_FLAG; + +/* Object header status flag definitions */ + h5o_flags[14] = (int_f)H5O_HDR_CHUNK0_SIZE; /* 2-bit field indicating # of bytes to store the size of chunk 0's data */ + h5o_flags[15] = (int_f)H5O_HDR_ATTR_CRT_ORDER_TRACKED; /* Attribute creation order is tracked */ + h5o_flags[16] = (int_f)H5O_HDR_ATTR_CRT_ORDER_INDEXED; /* Attribute creation order has index */ + h5o_flags[17] = (int_f)H5O_HDR_ATTR_STORE_PHASE_CHANGE; /* Non-default attribute storage phase change values stored */ + h5o_flags[18] = (int_f)H5O_HDR_STORE_TIMES; /* Store access, modification, change & birth times for object */ + h5o_flags[19] = (int_f)H5O_HDR_ALL_FLAGS; + +/* Maximum shared message values. Number of indexes is 8 to allow room to add + * new types of messages. + */ + h5o_flags[20] = (int_f)H5O_SHMESG_MAX_NINDEXES; + h5o_flags[21] = (int_f)H5O_SHMESG_MAX_LIST_SIZE; /* * H5P flags */ - h5p_flags[0] = H5P_FILE_CREATE; - h5p_flags[1] = H5P_FILE_ACCESS; - h5p_flags[2] = H5P_DATASET_CREATE; - h5p_flags[3] = H5P_DATASET_XFER; - h5p_flags[4] = H5P_FILE_MOUNT; - h5p_flags[5] = H5P_DEFAULT; - h5p_flags[6] = H5P_ROOT; - + h5p_flags[0] = (hid_t_f)H5P_FILE_CREATE; + h5p_flags[1] = (hid_t_f)H5P_FILE_ACCESS; + h5p_flags[2] = (hid_t_f)H5P_DATASET_CREATE; + h5p_flags[3] = (hid_t_f)H5P_DATASET_XFER; + h5p_flags[4] = (hid_t_f)H5P_FILE_MOUNT; + h5p_flags[5] = (hid_t_f)H5P_DEFAULT; + h5p_flags[6] = (hid_t_f)H5P_ROOT; + h5p_flags[7] = (hid_t_f)H5P_CRT_ORDER_INDEXED; + h5p_flags[8] = (hid_t_f)H5P_CRT_ORDER_TRACKED; + h5p_flags[9] = (hid_t_f)H5P_OBJECT_CREATE; + h5p_flags[10] = (hid_t_f)H5P_DATASET_ACCESS; + h5p_flags[11] = (hid_t_f)H5P_GROUP_CREATE; + h5p_flags[12] = (hid_t_f)H5P_GROUP_ACCESS; + h5p_flags[13] = (hid_t_f)H5P_DATATYPE_CREATE; + h5p_flags[14] = (hid_t_f)H5P_DATATYPE_ACCESS; + h5p_flags[15] = (hid_t_f)H5P_STRING_CREATE; + h5p_flags[16] = (hid_t_f)H5P_ATTRIBUTE_CREATE; + h5p_flags[17] = (hid_t_f)H5P_OBJECT_COPY; + h5p_flags[18] = (hid_t_f)H5P_LINK_CREATE; + h5p_flags[19] = (hid_t_f)H5P_LINK_ACCESS; /* * H5R flags */ - h5r_flags[0] = H5R_OBJECT; - h5r_flags[1] = H5R_DATASET_REGION; + h5r_flags[0] = (int_f)H5R_OBJECT; + h5r_flags[1] = (int_f)H5R_DATASET_REGION; /* * H5S flags */ - h5s_flags[0] = H5S_SCALAR; - h5s_flags[1] = H5S_SIMPLE; - h5s_flags[2] = H5S_NULL; - h5s_flags[3] = H5S_SELECT_SET; - h5s_flags[4] = H5S_SELECT_OR; + h5s_flags[0] = (int_f)H5S_SCALAR; + h5s_flags[1] = (int_f)H5S_SIMPLE; + h5s_flags[2] = (int_f)H5S_NULL; + h5s_flags[3] = (int_f)H5S_SELECT_SET; + h5s_flags[4] = (int_f)H5S_SELECT_OR; h5s_flags[5] = (int_f)H5S_UNLIMITED; h5s_flags[6] = (int_f)H5S_ALL; - h5s_flags[7] = H5S_SELECT_NOOP; - h5s_flags[8] = H5S_SELECT_AND; - h5s_flags[9] = H5S_SELECT_XOR; - h5s_flags[10] = H5S_SELECT_NOTB; - h5s_flags[11] = H5S_SELECT_NOTA; - h5s_flags[12] = H5S_SELECT_APPEND; - h5s_flags[13] = H5S_SELECT_PREPEND; - h5s_flags[14] = H5S_SELECT_INVALID; + h5s_flags[7] = (int_f)H5S_SELECT_NOOP; + h5s_flags[8] = (int_f)H5S_SELECT_AND; + h5s_flags[9] = (int_f)H5S_SELECT_XOR; + h5s_flags[10] = (int_f)H5S_SELECT_NOTB; + h5s_flags[11] = (int_f)H5S_SELECT_NOTA; + h5s_flags[12] = (int_f)H5S_SELECT_APPEND; + h5s_flags[13] = (int_f)H5S_SELECT_PREPEND; + h5s_flags[14] = (int_f)H5S_SELECT_INVALID; - h5s_flags[15] = H5S_SEL_ERROR; - h5s_flags[16] = H5S_SEL_NONE; - h5s_flags[17] = H5S_SEL_POINTS; - h5s_flags[18] = H5S_SEL_HYPERSLABS; - h5s_flags[19] = H5S_SEL_ALL; + h5s_flags[15] = (int_f)H5S_SEL_ERROR; + h5s_flags[16] = (int_f)H5S_SEL_NONE; + h5s_flags[17] = (int_f)H5S_SEL_POINTS; + h5s_flags[18] = (int_f)H5S_SEL_HYPERSLABS; + h5s_flags[19] = (int_f)H5S_SEL_ALL; /* * H5T flags */ - h5t_flags[0] = H5T_NO_CLASS; - h5t_flags[1] = H5T_INTEGER; - h5t_flags[2] = H5T_FLOAT; - h5t_flags[3] = H5T_TIME; - h5t_flags[4] = H5T_STRING; - h5t_flags[5] = H5T_BITFIELD; - h5t_flags[6] = H5T_OPAQUE; - h5t_flags[7] = H5T_COMPOUND; - h5t_flags[8] = H5T_REFERENCE; - h5t_flags[9] = H5T_ENUM; - h5t_flags[10] = H5T_ORDER_LE; - h5t_flags[11] = H5T_ORDER_BE; - h5t_flags[12] = H5T_ORDER_VAX; - h5t_flags[13] = H5T_PAD_ZERO; - h5t_flags[14] = H5T_PAD_ONE; - h5t_flags[15] = H5T_PAD_BACKGROUND; - h5t_flags[16] = H5T_PAD_ERROR; - h5t_flags[17] = H5T_SGN_NONE; - h5t_flags[18] = H5T_SGN_2; - h5t_flags[19] = H5T_SGN_ERROR; - h5t_flags[20] = H5T_NORM_IMPLIED; - h5t_flags[21] = H5T_NORM_MSBSET; - h5t_flags[22] = H5T_NORM_NONE; - h5t_flags[23] = H5T_CSET_ASCII; - h5t_flags[24] = H5T_CSET_UTF8; - h5t_flags[25] = H5T_STR_NULLTERM; - h5t_flags[26] = H5T_STR_NULLPAD; - h5t_flags[27] = H5T_STR_SPACEPAD; - h5t_flags[28] = H5T_STR_ERROR; - h5t_flags[29] = H5T_VLEN; - h5t_flags[30] = H5T_ARRAY; + h5t_flags[0] = (int_f)H5T_NO_CLASS; + h5t_flags[1] = (int_f)H5T_INTEGER; + h5t_flags[2] = (int_f)H5T_FLOAT; + h5t_flags[3] = (int_f)H5T_TIME; + h5t_flags[4] = (int_f)H5T_STRING; + h5t_flags[5] = (int_f)H5T_BITFIELD; + h5t_flags[6] = (int_f)H5T_OPAQUE; + h5t_flags[7] = (int_f)H5T_COMPOUND; + h5t_flags[8] = (int_f)H5T_REFERENCE; + h5t_flags[9] = (int_f)H5T_ENUM; + h5t_flags[10] = (int_f)H5T_ORDER_LE; + h5t_flags[11] = (int_f)H5T_ORDER_BE; + h5t_flags[12] = (int_f)H5T_ORDER_VAX; + h5t_flags[13] = (int_f)H5T_PAD_ZERO; + h5t_flags[14] = (int_f)H5T_PAD_ONE; + h5t_flags[15] = (int_f)H5T_PAD_BACKGROUND; + h5t_flags[16] = (int_f)H5T_PAD_ERROR; + h5t_flags[17] = (int_f)H5T_SGN_NONE; + h5t_flags[18] = (int_f)H5T_SGN_2; + h5t_flags[19] = (int_f)H5T_SGN_ERROR; + h5t_flags[20] = (int_f)H5T_NORM_IMPLIED; + h5t_flags[21] = (int_f)H5T_NORM_MSBSET; + h5t_flags[22] = (int_f)H5T_NORM_NONE; + h5t_flags[23] = (int_f)H5T_CSET_ASCII; + h5t_flags[24] = (int_f)H5T_CSET_UTF8; + h5t_flags[25] = (int_f)H5T_STR_NULLTERM; + h5t_flags[26] = (int_f)H5T_STR_NULLPAD; + h5t_flags[27] = (int_f)H5T_STR_SPACEPAD; + h5t_flags[28] = (int_f)H5T_STR_ERROR; + h5t_flags[29] = (int_f)H5T_VLEN; + h5t_flags[30] = (int_f)H5T_ARRAY; /* * H5Z flags */ - h5z_flags[0] = H5Z_FILTER_ERROR; - h5z_flags[1] = H5Z_FILTER_NONE; - h5z_flags[2] = H5Z_FILTER_DEFLATE; - h5z_flags[3] = H5Z_FILTER_SHUFFLE; - h5z_flags[4] = H5Z_FILTER_FLETCHER32; - h5z_flags[5] = H5Z_ERROR_EDC; - h5z_flags[6] = H5Z_DISABLE_EDC; - h5z_flags[7] = H5Z_ENABLE_EDC; - h5z_flags[8] = H5Z_NO_EDC; - h5z_flags[9] = H5Z_FILTER_SZIP; - h5z_flags[10] = H5Z_FLAG_OPTIONAL; - h5z_flags[11] = H5Z_FILTER_CONFIG_ENCODE_ENABLED; - h5z_flags[12] = H5Z_FILTER_CONFIG_DECODE_ENABLED; - h5z_flags[13] = H5Z_FILTER_ALL; + h5z_flags[0] = (int_f)H5Z_FILTER_ERROR; + h5z_flags[1] = (int_f)H5Z_FILTER_NONE; + h5z_flags[2] = (int_f)H5Z_FILTER_DEFLATE; + h5z_flags[3] = (int_f)H5Z_FILTER_SHUFFLE; + h5z_flags[4] = (int_f)H5Z_FILTER_FLETCHER32; + h5z_flags[5] = (int_f)H5Z_ERROR_EDC; + h5z_flags[6] = (int_f)H5Z_DISABLE_EDC; + h5z_flags[7] = (int_f)H5Z_ENABLE_EDC; + h5z_flags[8] = (int_f)H5Z_NO_EDC; + h5z_flags[9] = (int_f)H5Z_FILTER_SZIP; + h5z_flags[10] = (int_f)H5Z_FLAG_OPTIONAL; + h5z_flags[11] = (int_f)H5Z_FILTER_CONFIG_ENCODE_ENABLED; + h5z_flags[12] = (int_f)H5Z_FILTER_CONFIG_DECODE_ENABLED; + h5z_flags[13] = (int_f)H5Z_FILTER_ALL; +/* + * H5A flags + */ + + +/* + * H5 Generic flags introduced in version 1.8 -MSB- + */ + + /* H5_index_t enum struct */ + + h5_generic_flags[0] = (int_f)H5_INDEX_UNKNOWN; /* Unknown index type */ + h5_generic_flags[1] = (int_f)H5_INDEX_NAME; /* Index on names */ + h5_generic_flags[2] = (int_f)H5_INDEX_CRT_ORDER; /* Index on creation order */ + h5_generic_flags[3] = (int_f)H5_INDEX_N; /* Index on creation order */ + + + /* H5_iter_order_t enum struct */ + + h5_generic_flags[4] = (int_f)H5_ITER_UNKNOWN; /* Unknown order */ + h5_generic_flags[5] = (int_f)H5_ITER_INC; /* Increasing order */ + h5_generic_flags[6] = (int_f)H5_ITER_DEC; /* Decreasing order */ + h5_generic_flags[7] = (int_f)H5_ITER_NATIVE; /* No particular order, whatever is fastest */ + h5_generic_flags[8] = (int_f)H5_ITER_N; /* Number of iteration orders */ ret_value = 0; return ret_value; diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90 index eeffa34..899ce00 100644 --- a/fortran/src/H5_ff.f90 +++ b/fortran/src/H5_ff.f90 @@ -13,8 +13,9 @@ ! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! - MODULE H5LIB - CONTAINS +MODULE H5LIB + +CONTAINS !---------------------------------------------------------------------- ! Name: h5open_f ! @@ -37,18 +38,18 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5open_f(error) + SUBROUTINE h5open_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5open_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTEGER :: error_0, error_1, error_2, error_3 + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTEGER :: error_0, error_1, error_2, error_3 ! INTEGER, EXTERNAL :: h5init_types_c ! INTEGER, EXTERNAL :: h5init_flags_c ! INTEGER, EXTERNAL :: h5init1_flags_c @@ -57,78 +58,87 @@ ! ! MS FORTRAN needs explicit interfaces for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5open_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OPEN_C'::h5open_c - !DEC$ ENDIF - END FUNCTION h5open_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init_types_c(p_types, f_types, i_types) - USE H5GLOBAL - INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: i_types - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_TYPES_C'::h5init_types_c - !DEC$ ENDIF - END FUNCTION h5init_types_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init_flags_c(i_H5D_flags, & - i_H5F_flags, & - i_H5FD_flags, & - i_H5FD_hid_flags, & - i_H5G_flags, & - i_H5I_flags, & - i_H5P_flags, & - i_H5R_flags, & - i_H5S_flags, & - i_H5T_flags, & - i_H5Z_flags) - USE H5GLOBAL - INTEGER i_H5F_flags(H5F_FLAGS_LEN) - INTEGER i_H5G_flags(H5G_FLAGS_LEN) - INTEGER i_H5D_flags(H5D_FLAGS_LEN) - INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) - INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) - INTEGER i_H5I_flags(H5I_FLAGS_LEN) - INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) - INTEGER i_H5R_flags(H5R_FLAGS_LEN) - INTEGER i_H5S_flags(H5S_FLAGS_LEN) - INTEGER i_H5T_flags(H5T_FLAGS_LEN) - INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) + INTERFACE + INTEGER FUNCTION h5open_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OPEN_C'::h5open_c + !DEC$ ENDIF + END FUNCTION h5open_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init_types_c(p_types, f_types, i_types) + USE H5GLOBAL + INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: i_types + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_TYPES_C'::h5init_types_c + !DEC$ ENDIF + END FUNCTION h5init_types_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init_flags_c(i_H5D_flags, & + i_H5F_flags, & + i_H5FD_flags, & + i_H5FD_hid_flags, & + i_H5G_flags, & + i_H5I_flags, & + i_H5L_flags, & + i_H5O_flags, & + i_H5P_flags, & + i_H5R_flags, & + i_H5S_flags, & + i_H5T_flags, & + i_H5Z_flags, & + i_H5generic_flags) + USE H5GLOBAL + INTEGER i_H5F_flags(H5F_FLAGS_LEN) + INTEGER i_H5G_flags(H5G_FLAGS_LEN) + INTEGER i_H5D_flags(H5D_FLAGS_LEN) + INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) + INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) + INTEGER i_H5I_flags(H5I_FLAGS_LEN) + INTEGER i_H5L_flags(H5L_FLAGS_LEN) + INTEGER i_H5O_flags(H5O_FLAGS_LEN) + INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) + INTEGER i_H5R_flags(H5R_FLAGS_LEN) + INTEGER i_H5S_flags(H5S_FLAGS_LEN) + INTEGER i_H5T_flags(H5T_FLAGS_LEN) + INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) + INTEGER i_H5generic_flags(H5generic_FLAGS_LEN) !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_FLAGS_C'::h5init_flags_c !DEC$ ENDIF - END FUNCTION h5init_flags_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init1_flags_c( i_H5LIB_flags ) - USE H5GLOBAL - INTEGER i_H5LIB_flags(H5LIB_FLAGS_LEN) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT1_FLAGS_C'::h5init1_flags_c - !DEC$ ENDIF - END FUNCTION h5init1_flags_c - END INTERFACE - error_0 = h5open_c() - error_1 = h5init_types_c(predef_types, floating_types, integer_types) - error_2 = h5init_flags_c(H5D_flags, & - H5F_flags, & - H5FD_flags, & - H5FD_hid_flags, & - H5G_flags, & - H5I_flags, & - H5P_flags, & - H5R_flags, & - H5S_flags, & - H5T_flags, & - H5Z_flags) - error_3 = h5init1_flags_c(H5LIB_flags ) - error = error_0 + error_1 + error_2 + error_3 - END SUBROUTINE h5open_f + END FUNCTION h5init_flags_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init1_flags_c( i_H5LIB_flags ) + USE H5GLOBAL + INTEGER i_H5LIB_flags(H5LIB_FLAGS_LEN) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT1_FLAGS_C'::h5init1_flags_c + !DEC$ ENDIF + END FUNCTION h5init1_flags_c + END INTERFACE + error_0 = h5open_c() + error_1 = h5init_types_c(predef_types, floating_types, integer_types) + error_2 = h5init_flags_c(H5D_flags, & + H5F_flags, & + H5FD_flags, & + H5FD_hid_flags, & + H5G_flags, & + H5I_flags, & + H5L_flags, & + H5O_flags, & + H5P_flags, & + H5R_flags, & + H5S_flags, & + H5T_flags, & + H5Z_flags, & + H5generic_flags) + error_3 = h5init1_flags_c(H5LIB_flags ) + error = error_0 + error_1 + error_2 + error_3 + END SUBROUTINE h5open_f !---------------------------------------------------------------------- ! Name: h5close_f @@ -153,49 +163,49 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5close_f(error) + SUBROUTINE h5close_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5close_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL - IMPLICIT NONE - INTEGER :: error_1, error_2 - INTEGER, INTENT(OUT) :: error -! INTEGER, EXTERNAL :: h5close_types_c, h5close_c - INTERFACE - INTEGER FUNCTION h5close_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_C'::h5close_c - !DEC$ ENDIF - END FUNCTION h5close_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & - f_types, F_TYPES_LEN, & - i_types, I_TYPES_LEN ) - USE H5GLOBAL - INTEGER P_TYPES_LEN - INTEGER F_TYPES_LEN - INTEGER I_TYPES_LEN - INTEGER(HID_T), DIMENSION(P_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(F_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(I_TYPES_LEN) :: i_types - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_TYPES_C'::h5close_types_c - !DEC$ ENDIF - END FUNCTION h5close_types_c - END INTERFACE - error_1 = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & - floating_types, FLOATING_TYPES_LEN, & - integer_types, INTEGER_TYPES_LEN ) - error_2 = h5close_c() - error = error_1 + error_2 + IMPLICIT NONE + INTEGER :: error_1, error_2 + INTEGER, INTENT(OUT) :: error + ! INTEGER, EXTERNAL :: h5close_types_c, h5close_c + INTERFACE + INTEGER FUNCTION h5close_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_C'::h5close_c + !DEC$ ENDIF + END FUNCTION h5close_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & + f_types, F_TYPES_LEN, & + i_types, I_TYPES_LEN ) + USE H5GLOBAL + INTEGER P_TYPES_LEN + INTEGER F_TYPES_LEN + INTEGER I_TYPES_LEN + INTEGER(HID_T), DIMENSION(P_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(F_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(I_TYPES_LEN) :: i_types + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_TYPES_C'::h5close_types_c + !DEC$ ENDIF + END FUNCTION h5close_types_c + END INTERFACE + error_1 = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & + floating_types, FLOATING_TYPES_LEN, & + integer_types, INTEGER_TYPES_LEN ) + error_2 = h5close_c() + error = error_1 + error_2 - END SUBROUTINE h5close_f + END SUBROUTINE h5close_f !---------------------------------------------------------------------- ! Name: h5get_libversion_f @@ -219,29 +229,29 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5get_libversion_f(majnum, minnum, relnum, error) + SUBROUTINE h5get_libversion_f(majnum, minnum, relnum, error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5get_libversion_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(OUT) :: majnum, minnum, relnum, error - INTERFACE - INTEGER FUNCTION h5get_libversion_c(majnum, minnum, relnum) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GET_LIBVERSION_C'::h5get_libversion_c - !DEC$ ENDIF - INTEGER, INTENT(OUT) :: majnum, minnum, relnum - END FUNCTION h5get_libversion_c - END INTERFACE - - error = h5get_libversion_c(majnum, minnum, relnum) - - END SUBROUTINE h5get_libversion_f + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: majnum, minnum, relnum, error + INTERFACE + INTEGER FUNCTION h5get_libversion_c(majnum, minnum, relnum) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GET_LIBVERSION_C'::h5get_libversion_c + !DEC$ ENDIF + INTEGER, INTENT(OUT) :: majnum, minnum, relnum + END FUNCTION h5get_libversion_c + END INTERFACE + + error = h5get_libversion_c(majnum, minnum, relnum) + + END SUBROUTINE h5get_libversion_f !---------------------------------------------------------------------- ! Name: h5check_version_f @@ -265,30 +275,30 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5check_version_f(majnum, minnum, relnum, error) + SUBROUTINE h5check_version_f(majnum, minnum, relnum, error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5check_version_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(IN) :: majnum, minnum, relnum - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5check_version_c(majnum, minnum, relnum) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CHECK_VERSION_C'::h5check_version_c - !DEC$ ENDIF - INTEGER, INTENT(IN) :: majnum, minnum, relnum - END FUNCTION h5check_version_c - END INTERFACE - - error = h5check_version_c(majnum, minnum, relnum) - - END SUBROUTINE h5check_version_f + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(IN) :: majnum, minnum, relnum + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5check_version_c(majnum, minnum, relnum) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CHECK_VERSION_C'::h5check_version_c + !DEC$ ENDIF + INTEGER, INTENT(IN) :: majnum, minnum, relnum + END FUNCTION h5check_version_c + END INTERFACE + + error = h5check_version_c(majnum, minnum, relnum) + + END SUBROUTINE h5check_version_f !---------------------------------------------------------------------- ! Name: h5garbage_collect_f @@ -310,28 +320,28 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5garbage_collect_f(error) + SUBROUTINE h5garbage_collect_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5garbage_collect_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5garbage_collect_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GARBAGE_COLLECT_C'::h5garbage_collect_c + !DEC$ ENDIF + END FUNCTION h5garbage_collect_c + END INTERFACE + + error = h5garbage_collect_c() - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5garbage_collect_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GARBAGE_COLLECT_C'::h5garbage_collect_c - !DEC$ ENDIF - END FUNCTION h5garbage_collect_c - END INTERFACE - - error = h5garbage_collect_c() - - END SUBROUTINE h5garbage_collect_f + END SUBROUTINE h5garbage_collect_f !---------------------------------------------------------------------- ! Name: h5dont_atexit_f @@ -353,26 +363,26 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5dont_atexit_f(error) + SUBROUTINE h5dont_atexit_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5dont_atexit_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5dont_atexit_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DONT_ATEXIT_C'::h5dont_atexit_c - !DEC$ ENDIF - END FUNCTION h5dont_atexit_c - END INTERFACE - - error = h5dont_atexit_c() - - END SUBROUTINE h5dont_atexit_f - END MODULE H5LIB + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5dont_atexit_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DONT_ATEXIT_C'::h5dont_atexit_c + !DEC$ ENDIF + END FUNCTION h5dont_atexit_c + END INTERFACE + + error = h5dont_atexit_c() + + END SUBROUTINE h5dont_atexit_f +END MODULE H5LIB diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90 index a13d732..42f5cf0 100644 --- a/fortran/src/H5f90global.f90 +++ b/fortran/src/H5f90global.f90 @@ -15,19 +15,20 @@ ! MODULE H5GLOBAL USE H5FORTRAN_TYPES +! ! ! Definitions for reference datatypes. ! If you change the value of these parameters, do not forget to change corresponding ! values in the H5f90.h file. - INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 + INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3 - TYPE hobj_ref_t_f - INTEGER(HADDR_T) ref - END TYPE + TYPE hobj_ref_t_f + INTEGER(HADDR_T) ref + END TYPE hobj_ref_t_f - TYPE hdset_reg_ref_t_f - INTEGER ref(REF_REG_BUF_LEN) - END TYPE + TYPE hdset_reg_ref_t_f + INTEGER ref(REF_REG_BUF_LEN) + END TYPE hdset_reg_ref_t_f INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 6 ! Do not forget to change this ! value when new predefined @@ -41,32 +42,32 @@ INTEGER, PARAMETER :: INTEGER_TYPES_LEN = 17 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, & - H5T_STRING + 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, & + H5T_STRING INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: predef_types @@ -76,13 +77,13 @@ 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) @@ -151,7 +152,7 @@ ! ! H5F flags declaration ! - INTEGER, PARAMETER :: H5F_FLAGS_LEN = 16 + INTEGER, PARAMETER :: H5F_FLAGS_LEN = 19 INTEGER H5F_flags(H5F_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ ATTRIBUTES DLLEXPORT :: /H5F_FLAGS/ @@ -174,6 +175,8 @@ INTEGER :: H5F_OBJ_GROUP_F INTEGER :: H5F_OBJ_DATATYPE_F INTEGER :: H5F_OBJ_ALL_F + INTEGER :: H5F_LIBVER_EARLIEST_F + INTEGER :: H5F_LIBVER_LATEST_F EQUIVALENCE(H5F_flags(1), H5F_ACC_RDWR_F) EQUIVALENCE(H5F_flags(2), H5F_ACC_RDONLY_F) @@ -191,10 +194,43 @@ EQUIVALENCE(H5F_flags(14), H5F_OBJ_GROUP_F) EQUIVALENCE(H5F_flags(15), H5F_OBJ_DATATYPE_F) EQUIVALENCE(H5F_flags(16), H5F_OBJ_ALL_F) + EQUIVALENCE(H5F_flags(17), H5F_LIBVER_EARLIEST_F) + EQUIVALENCE(H5F_flags(18), H5F_LIBVER_LATEST_F) +! +! H5generic flags declaration +! + INTEGER, PARAMETER :: H5generic_FLAGS_LEN = 9 + INTEGER H5generic_flags(H5generic_FLAGS_LEN) +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$ ATTRIBUTES DLLEXPORT :: /H5generic_FLAGS/ +!DEC$endif + COMMON /H5generic_FLAGS/ H5generic_flags + + INTEGER :: H5_INDEX_UNKNOWN_F + INTEGER :: H5_INDEX_NAME_F + INTEGER :: H5_INDEX_CRT_ORDER_F + INTEGER :: H5_INDEX_N_F + INTEGER :: H5_ITER_UNKNOWN_F + INTEGER :: H5_ITER_INC_F + INTEGER :: H5_ITER_DEC_F + INTEGER :: H5_ITER_NATIVE_F + INTEGER :: H5_ITER_N_F + + EQUIVALENCE(H5generic_flags(1), H5_INDEX_UNKNOWN_F) + EQUIVALENCE(H5generic_flags(2), H5_INDEX_NAME_F) + EQUIVALENCE(H5generic_flags(3), H5_INDEX_CRT_ORDER_F) + EQUIVALENCE(H5generic_flags(4), H5_INDEX_N_F) + EQUIVALENCE(H5generic_flags(5), H5_ITER_UNKNOWN_F) + EQUIVALENCE(H5generic_flags(6), H5_ITER_INC_F) + EQUIVALENCE(H5generic_flags(7), H5_ITER_DEC_F) + EQUIVALENCE(H5generic_flags(8), H5_ITER_NATIVE_F) + EQUIVALENCE(H5generic_flags(9), H5_ITER_N_F) + + ! ! H5G flags declaration ! - INTEGER, PARAMETER :: H5G_FLAGS_LEN = 8 + INTEGER, PARAMETER :: H5G_FLAGS_LEN = 12 INTEGER H5G_flags(H5G_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ ATTRIBUTES DLLEXPORT :: /H5G_FLAGS/ @@ -210,16 +246,26 @@ INTEGER :: H5G_LINK_ERROR_F INTEGER :: H5G_LINK_HARD_F INTEGER :: H5G_LINK_SOFT_F + INTEGER :: H5G_STORAGE_TYPE_UNKNOWN_F + INTEGER :: H5G_STORAGE_TYPE_SYMBOL_TABLE_F + INTEGER :: H5G_STORAGE_TYPE_COMPACT_F + INTEGER :: H5G_STORAGE_TYPE_DENSE_F EQUIVALENCE(H5G_flags(1), H5G_UNKNOWN_F) EQUIVALENCE(H5G_flags(2), H5G_GROUP_F) EQUIVALENCE(H5G_flags(3), H5G_DATASET_F) EQUIVALENCE(H5G_flags(4), H5G_TYPE_F) -! XXX: Fix problems with H5G_LINK_F! - QAK +! XXX: Fix problems with H5G_LINK_F! - QAK ! these are really H5L values -MSB- EQUIVALENCE(H5G_flags(5), H5G_LINK_F) - EQUIVALENCE(H5G_flags(6), H5G_LINK_ERROR_F) - EQUIVALENCE(H5G_flags(7), H5G_LINK_HARD_F) - EQUIVALENCE(H5G_flags(8), H5G_LINK_SOFT_F) + EQUIVALENCE(H5G_flags(6), H5G_LINK_ERROR_F) + EQUIVALENCE(H5G_flags(7), H5G_LINK_HARD_F) + EQUIVALENCE(H5G_flags(8), H5G_LINK_SOFT_F) +! XXX + + EQUIVALENCE(H5G_flags(9), H5G_STORAGE_TYPE_UNKNOWN_F ) + EQUIVALENCE(H5G_flags(10), H5G_STORAGE_TYPE_SYMBOL_TABLE_F) + EQUIVALENCE(H5G_flags(11), H5G_STORAGE_TYPE_COMPACT_F) + EQUIVALENCE(H5G_flags(12), H5G_STORAGE_TYPE_DENSE_F) ! ! H5D flags declaration ! @@ -338,8 +384,6 @@ EQUIVALENCE(H5FD_hid_flags(6), H5FD_SEC2_F) EQUIVALENCE(H5FD_hid_flags(7), H5FD_STDIO_F) - - ! ! H5I flags declaration ! @@ -365,24 +409,116 @@ EQUIVALENCE(H5I_flags(5), H5I_DATASET_F) EQUIVALENCE(H5I_flags(6), H5I_ATTR_F) EQUIVALENCE(H5I_flags(7), H5I_BADID_F) +! +! H5L flags declaration +! + INTEGER, PARAMETER :: H5L_FLAGS_LEN = 6 + INTEGER :: H5L_flags(H5L_FLAGS_LEN) + + INTEGER :: H5L_LINK_F + INTEGER :: H5L_LINK_ERROR_F + INTEGER :: H5L_LINK_HARD_F + INTEGER :: H5L_LINK_SOFT_F + INTEGER :: H5L_SAME_LOC_F + INTEGER :: H5L_LINK_CLASS_T_VERS_F + +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$ ATTRIBUTES DLLEXPORT :: /H5L_FLAGS/ +!DEC$endif + COMMON /H5L_FLAGS/ H5L_flags + + EQUIVALENCE(H5L_flags(1), H5L_LINK_F) + EQUIVALENCE(H5L_flags(2), H5L_LINK_ERROR_F) + EQUIVALENCE(H5L_flags(3), H5L_LINK_HARD_F) + EQUIVALENCE(H5L_flags(4), H5L_LINK_SOFT_F) + EQUIVALENCE(H5L_flags(5), H5L_SAME_LOC_F) + EQUIVALENCE(H5L_flags(6), H5L_LINK_CLASS_T_VERS_F) +! +! H5O flags declaration +! + INTEGER, PARAMETER :: H5O_FLAGS_LEN = 22 + INTEGER :: H5o_flags(H5O_FLAGS_LEN) +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$ ATTRIBUTES DLLEXPORT :: /H5O_FLAGS/ +!DEC$endif + COMMON /H5O_FLAGS/ H5O_flags + + INTEGER :: H5O_COPY_SHALLOW_HIERARCHY_F ! * THESE VARIABLES DO + INTEGER :: H5O_COPY_EXPAND_SOFT_LINK_F ! NOT MATCH THE C VARIABLE + INTEGER :: H5O_COPY_EXPAND_EXT_LINK_F ! IN ORDER + INTEGER :: H5O_COPY_EXPAND_REFERENCE_F ! TO STAY UNDER THE + INTEGER :: H5O_COPY_WITHOUT_ATTR_FLAG_F + INTEGER :: H5O_COPY_PRESERVE_NULL_FLAG_F + INTEGER :: H5O_COPY_ALL_F + INTEGER :: H5O_SHMESG_NONE_FLAG_F + INTEGER :: H5O_SHMESG_SDSPACE_FLAG_F + INTEGER :: H5O_SHMESG_DTYPE_FLAG_F + INTEGER :: H5O_SHMESG_FILL_FLAG_F + INTEGER :: H5O_SHMESG_PLINE_FLAG_F + INTEGER :: H5O_SHMESG_ATTR_FLAG_F + INTEGER :: H5O_SHMESG_ALL_FLAG_F + INTEGER :: H5O_HDR_CHUNK0_SIZE_F + INTEGER :: H5O_HDR_ATTR_CRT_ORDER_TRACK_F ! 32 CHARACTER + INTEGER :: H5O_HDR_ATTR_CRT_ORDER_INDEX_F ! VARIABLE + INTEGER :: H5O_HDR_ATTR_STORE_PHASE_CHA_F ! LENGTH * + INTEGER :: H5O_HDR_STORE_TIMES_F + INTEGER :: H5O_HDR_ALL_FLAGS_F + INTEGER :: H5O_SHMESG_MAX_NINDEXES_F + INTEGER :: H5O_SHMESG_MAX_LIST_SIZE_F + + EQUIVALENCE(h5o_flags(1) , H5O_COPY_SHALLOW_HIERARCHY_F) + EQUIVALENCE(h5o_flags(2) , H5O_COPY_EXPAND_SOFT_LINK_F) + EQUIVALENCE(h5o_flags(3) , H5O_COPY_EXPAND_EXT_LINK_F) + EQUIVALENCE(h5o_flags(4) , H5O_COPY_EXPAND_REFERENCE_F) + EQUIVALENCE(h5o_flags(5) , H5O_COPY_WITHOUT_ATTR_FLAG_F) + EQUIVALENCE(h5o_flags(6) , H5O_COPY_PRESERVE_NULL_FLAG_F) + EQUIVALENCE(h5o_flags(7) , H5O_COPY_ALL_F) + EQUIVALENCE(h5o_flags(8) , H5O_SHMESG_NONE_FLAG_F) + EQUIVALENCE(h5o_flags(9) , H5O_SHMESG_SDSPACE_FLAG_F) + EQUIVALENCE(h5o_flags(10) , H5O_SHMESG_DTYPE_FLAG_F) + EQUIVALENCE(h5o_flags(11) , H5O_SHMESG_FILL_FLAG_F) + EQUIVALENCE(h5o_flags(12) , H5O_SHMESG_PLINE_FLAG_F) + EQUIVALENCE(h5o_flags(13) , H5O_SHMESG_ATTR_FLAG_F) + EQUIVALENCE(h5o_flags(14) , H5O_SHMESG_ALL_FLAG_F) + EQUIVALENCE(h5o_flags(15) , H5O_HDR_CHUNK0_SIZE_F) + EQUIVALENCE(h5o_flags(16) , H5O_HDR_ATTR_CRT_ORDER_TRACK_F) + EQUIVALENCE(h5o_flags(17) , H5O_HDR_ATTR_CRT_ORDER_INDEX_F) + EQUIVALENCE(h5o_flags(18) , H5O_HDR_ATTR_STORE_PHASE_CHA_F) + EQUIVALENCE(h5o_flags(19) , H5O_HDR_STORE_TIMES_F) + EQUIVALENCE(h5o_flags(20) , H5O_HDR_ALL_FLAGS_F) + EQUIVALENCE(h5o_flags(21) , H5O_SHMESG_MAX_NINDEXES_F) + EQUIVALENCE(h5o_flags(22) , H5O_SHMESG_MAX_LIST_SIZE_F) ! ! H5P flags declaration ! - INTEGER, PARAMETER :: H5P_FLAGS_LEN = 7 + INTEGER, PARAMETER :: H5P_FLAGS_LEN = 20 INTEGER(HID_T) H5P_flags(H5P_FLAGS_LEN) !DEC$if defined(BUILD_HDF5_DLL) !DEC$ ATTRIBUTES DLLEXPORT :: /H5P_FLAGS/ !DEC$endif COMMON /H5P_FLAGS/ H5P_flags - INTEGER(HID_T) :: H5P_FILE_CREATE_F - INTEGER(HID_T) :: H5P_FILE_ACCESS_F - INTEGER(HID_T) :: H5P_DATASET_CREATE_F - INTEGER(HID_T) :: H5P_DATASET_XFER_F - INTEGER(HID_T) :: H5P_FILE_MOUNT_F - INTEGER(HID_T) :: H5P_DEFAULT_F - INTEGER(HID_T) :: H5P_ROOT_F + INTEGER(HID_T) :: H5P_FILE_CREATE_F + INTEGER(HID_T) :: H5P_FILE_ACCESS_F + INTEGER(HID_T) :: H5P_DATASET_CREATE_F + INTEGER(HID_T) :: H5P_DATASET_XFER_F + INTEGER(HID_T) :: H5P_FILE_MOUNT_F + INTEGER(HID_T) :: H5P_DEFAULT_F + INTEGER(HID_T) :: H5P_ROOT_F + INTEGER(HID_T) :: H5P_CRT_ORDER_INDEXED_F + INTEGER(HID_T) :: H5P_CRT_ORDER_TRACKED_F + INTEGER(HID_T) :: H5P_OBJECT_CREATE_F + INTEGER(HID_T) :: H5P_DATASET_ACCESS_F + INTEGER(HID_T) :: H5P_GROUP_CREATE_F + INTEGER(HID_T) :: H5P_GROUP_ACCESS_F + INTEGER(HID_T) :: H5P_DATATYPE_CREATE_F + INTEGER(HID_T) :: H5P_DATATYPE_ACCESS_F + INTEGER(HID_T) :: H5P_STRING_CREATE_F + INTEGER(HID_T) :: H5P_ATTRIBUTE_CREATE_F + INTEGER(HID_T) :: H5P_OBJECT_COPY_F + INTEGER(HID_T) :: H5P_LINK_CREATE_F + INTEGER(HID_T) :: H5P_LINK_ACCESS_F EQUIVALENCE(H5P_flags(1), H5P_FILE_CREATE_F) EQUIVALENCE(H5P_flags(2), H5P_FILE_ACCESS_F) @@ -391,9 +527,21 @@ EQUIVALENCE(H5P_flags(5), H5P_FILE_MOUNT_F) EQUIVALENCE(H5P_flags(6), H5P_DEFAULT_F) EQUIVALENCE(H5P_flags(7), H5P_ROOT_F) - + EQUIVALENCE(H5P_flags(8), H5P_CRT_ORDER_INDEXED_F) + EQUIVALENCE(H5P_flags(9), H5P_CRT_ORDER_TRACKED_F) + EQUIVALENCE(H5P_flags(10), H5P_OBJECT_CREATE_F) + EQUIVALENCE(H5P_flags(11), H5P_DATASET_ACCESS_F) + EQUIVALENCE(H5P_flags(12), H5P_GROUP_CREATE_F) + EQUIVALENCE(H5P_flags(13), H5P_GROUP_ACCESS_F) + EQUIVALENCE(H5P_flags(14), H5P_DATATYPE_CREATE_F) + EQUIVALENCE(H5P_flags(15), H5P_DATATYPE_ACCESS_F) + EQUIVALENCE(H5P_flags(16), H5P_STRING_CREATE_F) + EQUIVALENCE(H5P_flags(17), H5P_ATTRIBUTE_CREATE_F) + EQUIVALENCE(H5P_flags(18), H5P_OBJECT_COPY_F) + EQUIVALENCE(H5P_flags(19), H5P_LINK_CREATE_F) + EQUIVALENCE(H5P_flags(20), H5P_LINK_ACCESS_F) ! -! H5P flags declaration +! H5R flags declaration ! INTEGER, PARAMETER :: H5R_FLAGS_LEN = 2 INTEGER H5R_flags(H5R_FLAGS_LEN) @@ -592,11 +740,27 @@ !DEC$ ATTRIBUTES DLLEXPORT :: /H5LIB_FLAGS/ !DEC$endif COMMON /H5LIB_FLAGS/ H5LIB_flags - INTEGER :: H5_SZIP_EC_OM_F - INTEGER :: H5_SZIP_NN_OM_F + INTEGER :: H5_SZIP_EC_OM_F + INTEGER :: H5_SZIP_NN_OM_F ! - EQUIVALENCE(H5LIB_flags(1), H5_SZIP_EC_OM_F) - EQUIVALENCE(H5LIB_flags(2), H5_SZIP_NN_OM_F) + EQUIVALENCE(H5LIB_flags(1), H5_SZIP_EC_OM_F) + EQUIVALENCE(H5LIB_flags(2), H5_SZIP_NN_OM_F) + - END MODULE H5GLOBAL +! General H5 flags declarations +! +!!$ INTEGER, PARAMETER :: H5_FLAGS_LEN = 2 +!!$ INTEGER H5_flags(H5_FLAGS_LEN) +!!$!DEC$if defined(BUILD_HDF5_DLL) +!!$!DEC$ ATTRIBUTES DLLEXPORT :: /H5_FLAGS/ +!!$!DEC$endif +!!$ COMMON /H5_FLAGS/ H5_flags +!!$ +!!$ INTEGER :: _F +!!$ INTEGER :: H5F_SCOPE_LOCAL_F +!!$ +!!$ EQUIVALENCE(H5F_flags(1), H5F_SCOPE_GLOBAL_F) +!!$ EQUIVALENCE(H5F_flags(2), H5F_SCOPE_LOCAL_F) + + END MODULE H5GLOBAL diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 8099ecc..071b74a 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -93,6 +93,9 @@ H5_FCDLL int_f nh5fget_filesize_c(hid_t_f *file_id, hsize_t_f *size); # define nh5sselect_select_c H5_FC_FUNC_(h5sselect_select_c, H5SSELECT_SELECT_C) # define nh5sget_select_type_c H5_FC_FUNC_(h5sget_select_type_c, H5SGET_SELECT_TYPE_C) # define nh5sselect_elements_c H5_FC_FUNC_(h5sselect_elements_c, H5SSELECT_ELEMENTS_C) +# define nh5sdecode_c H5_FC_FUNC_(h5sdecode_c, H5SDECODE_C) +# define nh5sencode_c H5_FC_FUNC_(h5sencode_c, H5SENCODE_C) +# define nh5sextent_equal_c H5_FC_FUNC_(h5sextent_equal_c, H5SEXTENT_EQUAL_C) H5_FCDLL int_f nh5screate_simple_c ( int_f *rank, hsize_t_f *dims, hsize_t_f *maxdims, hid_t_f *space_id ); H5_FCDLL int_f nh5sclose_c ( hid_t_f *space_id ); @@ -123,6 +126,9 @@ H5_FCDLL int_f nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f * H5_FCDLL int_f nh5scombine_hyperslab_c ( hid_t_f *space_id , int_f *op, hsize_t_f *start, hsize_t_f *count, hsize_t_f *stride, hsize_t_f *block, hid_t_f *hyper_id); H5_FCDLL int_f nh5scombine_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id, hid_t_f *ds_id); H5_FCDLL int_f nh5sselect_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *space2_id); +H5_FCDLL int_f nh5sdecode_c ( _fcd buf, int_f *obj_id ); +H5_FCDLL int_f nh5sencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ); +H5_FCDLL int_f nh5sextent_equal_c ( hid_t_f * space1_id, hid_t_f *space2_id, hid_t_f *c_equal); /* * Functions from H5Df.c @@ -207,7 +213,7 @@ H5_FCDLL int_f nh5sselect_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *sp # define nh5dget_space_c H5_FC_FUNC_(h5dget_space_c, H5DGET_SPACE_C) # define nh5dget_type_c H5_FC_FUNC_(h5dget_type_c, H5DGET_TYPE_C) # define nh5dget_create_plist_c H5_FC_FUNC_(h5dget_create_plist_c, H5DGET_CREATE_PLIST_C) -# define nh5dextend_c H5_FC_FUNC_(h5dextend_c, H5DEXTEND_C) +# define nh5dset_extent_c H5_FC_FUNC_(h5dset_extent_c, H5DSET_EXTENT_C) # define nh5dget_storage_size_c H5_FC_FUNC_(h5dget_storage_size_c, H5DGET_STORAGE_SIZE_C) # define nh5dvlen_get_max_len_c H5_FC_FUNC_(h5dvlen_get_max_len_c, H5DVLEN_GET_MAX_LEN_C) # define nh5dwrite_vl_integer_c H5_FC_FUNC_(h5dwrite_vl_integer_c, H5DWRITE_VL_INTEGER_C) @@ -222,12 +228,13 @@ H5_FCDLL int_f nh5sselect_select_c ( hid_t_f *space1_id , int_f *op, hid_t_f *sp # define nh5dfill_real_c H5_FC_FUNC_(h5dfill_real_c, H5DFILL_REAL_C) # define nh5dfill_double_c H5_FC_FUNC_(h5dfill_double_c, H5DFILL_DOUBLE_C) # define nh5dget_space_status_c H5_FC_FUNC_(h5dget_space_status_c, H5DGET_SPACE_STATUS_C) +# define nh5dcreate_anon_c H5_FC_FUNC_(h5dcreate_anon_c, H5DCREATE_ANON_C) -H5_FCDLL 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); -H5_FCDLL int_f nh5dopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id); +H5_FCDLL 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 *lcpl_id, hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id); +H5_FCDLL int_f nh5dopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f *dset_id); H5_FCDLL int_f nh5dclose_c ( hid_t_f *dset_id ); - H5_FCDLL 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, hsize_t_f *dims); H5_FCDLL int_f nh5dwrite_integer_s_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, hsize_t_f *dims); H5_FCDLL int_f nh5dwrite_integer_1_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, hsize_t_f *dims); @@ -322,7 +329,7 @@ H5_FCDLL int_f nh5dreadc_7_c (hid_t_f *dset_id, hid_t_f *mem_type_id, hid_t_f *m H5_FCDLL int_f nh5dget_space_c ( hid_t_f *dset_id , hid_t_f *space_id); H5_FCDLL int_f nh5dget_type_c ( hid_t_f *dset_id , hid_t_f *type_id); H5_FCDLL int_f nh5dget_create_plist_c ( hid_t_f *dset_id , hid_t_f *plist_id); -H5_FCDLL int_f nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims); +H5_FCDLL int_f nh5dset_extent_c ( hid_t_f *dset_id , hsize_t_f *dims); H5_FCDLL int_f nh5dvlen_get_max_len_c(hid_t_f *dataset_id, hid_t_f *type_id, hid_t_f *space_id, size_t_f *len); H5_FCDLL int_f nh5dget_storage_size_c(hid_t_f *dataset_id, hsize_t_f *size); H5_FCDLL int_f nh5dfillc_c(_fcd fill_value, hid_t_f *fill_type_id, hid_t_f *space_id, _fcd buf, hid_t_f *mem_type_id); @@ -331,6 +338,8 @@ H5_FCDLL int_f nh5dfill_integer_c(void * fill_value, hid_t_f *fill_type_id, hid_ H5_FCDLL int_f nh5dfill_real_c(void * fill_value, hid_t_f *fill_type_id, hid_t_f *space_id, void * buf, hid_t_f *mem_type_id); H5_FCDLL int_f nh5dfill_double_c(void * fill_value, hid_t_f *fill_type_id, hid_t_f *space_id, void * buf, hid_t_f *mem_type_id); H5_FCDLL int_f nh5dget_space_status_c ( hid_t_f *dset_id, int_f *flag); +H5_FCDLL int_f nh5dcreate_anon_c (hid_t_f *loc_id, hid_t_f *type_id, hid_t_f *space_id, + hid_t_f *dcpl_id, hid_t_f *dapl_id, hid_t_f *dset_id); /*MSB*/ /* * Functions from H5Gf.c @@ -348,10 +357,16 @@ H5_FCDLL int_f nh5dget_space_status_c ( hid_t_f *dset_id, int_f *flag); # define nh5gget_linkval_c H5_FC_FUNC_(h5gget_linkval_c, H5GGET_LINKVAL_C) # define nh5gset_comment_c H5_FC_FUNC_(h5gset_comment_c, H5GSET_COMMENT_C) # define nh5gget_comment_c H5_FC_FUNC_(h5gget_comment_c, H5GGET_COMMENT_C) +# define nh5gcreate_anon_c H5_FC_FUNC_(h5gcreate_anon_c, H5GCREATE_ANON_C) +# define nh5gget_create_plist_c H5_FC_FUNC_(h5gget_create_plist_c, H5GGET_CREATE_PLIST_C) +# define nh5gget_info_c H5_FC_FUNC_(h5gget_info_c, H5GGET_INFO_C) +# define nh5gget_info_by_idx_c H5_FC_FUNC_(h5gget_info_by_idx_c, H5GGET_INFO_BY_IDX_C) +# define nh5gget_info_by_name_c H5_FC_FUNC_(h5gget_info_by_name_c, H5GGET_INFO_BY_NAME_C) -H5_FCDLL int_f nh5gcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, hid_t_f *grp_id); -H5_FCDLL int_f nh5gopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id); +H5_FCDLL int_f nh5gcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint, hid_t_f *grp_id, + hid_t_f *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id); +H5_FCDLL int_f nh5gopen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *gapl_id, hid_t_f *grp_id); H5_FCDLL int_f nh5gclose_c ( hid_t_f *grp_id ); H5_FCDLL 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); H5_FCDLL int_f nh5gn_members_c (hid_t_f *loc_id, _fcd name, int_f *namelen, int_f *nmembers); @@ -363,6 +378,14 @@ H5_FCDLL int_f nh5gmove2_c (hid_t_f *src_loc_id, _fcd src_name, int_f *src_namel H5_FCDLL int_f nh5gget_linkval_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size, _fcd value ); H5_FCDLL int_f nh5gset_comment_c (hid_t_f *loc_id, _fcd name, int_f *namelen, _fcd comment, int_f *commentlen); H5_FCDLL int_f nh5gget_comment_c (hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *bufsize, _fcd comment); +H5_FCDLL int_f nh5gcreate_anon_c (hid_t_f *loc_id, hid_t_f *gcpl_id, hid_t_f *gapl_id, hid_t_f *grp_id); /*MSB*/ +H5_FCDLL int_f nh5gget_create_plist_c(hid_t_f *grp_id, hid_t_f *gcpl_id ); /*MSB*/ +H5_FCDLL int_f nh5gget_info_c (hid_t_f *group_id, int_f *storage_type, int_f *nlinks, int_f *max_corder); /*MSB*/ +H5_FCDLL int_f nh5gget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + hid_t_f *index_type, hid_t_f *order, hsize_t_f *n, hid_t_f *lapl_id, + int_f *storage_type, int_f *nlinks, int_f *max_corder); /*MSB*/ +H5_FCDLL int_f nh5gget_info_by_name_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, hid_t_f *lapl_id, + int_f *storage_type, int_f *nlinks, int_f *max_corder); /*MSB*/ /* * Functions from H5Af.c @@ -444,9 +467,25 @@ H5_FCDLL int_f nh5gget_comment_c (hid_t_f *loc_id, _fcd name, int_f *namelen, si # define nh5aget_type_c H5_FC_FUNC_(h5aget_type_c, H5AGET_TYPE_C) # define nh5aget_num_attrs_c H5_FC_FUNC_(h5aget_num_attrs_c, H5AGET_NUM_ATTRS_C) # define nh5adelete_c H5_FC_FUNC_(h5adelete_c, H5ADELETE_C) +# define nh5aget_storage_size_c H5_FC_FUNC_(h5aget_storage_size_c, H5AGET_STORAGE_SIZE_C) /* MSB */ +# define nh5arename_by_name_c H5_FC_FUNC_(h5arename_by_name_c, H5ARENAME_BY_NAME_C) /* MSB */ +# define nh5aopen_c H5_FC_FUNC_(h5aopen_c, H5AOPEN_C) /* MSB */ +# define nh5adelete_by_name_c H5_FC_FUNC_(h5adelete_by_name_c,H5ADELETE_BY_NAME_C) /* MSB */ +# define nh5adelete_by_idx_c H5_FC_FUNC_(h5adelete_by_idx_c,H5ADELETE_BY_IDX_C) /* MSB */ +# define nh5aget_name_by_idx_c H5_FC_FUNC_(h5aget_name_by_idx_c,H5AGET_NAME_BY_IDX_C) /* MSB */ +# define nh5aget_create_plist_c H5_FC_FUNC_(h5aget_create_plist_c,H5AGET_CREATE_PLIST_C) /* MSB */ +# define nh5aopen_by_idx_c H5_FC_FUNC_(h5aopen_by_idx_c,H5AOPEN_BY_IDX_C) /* MSB */ +# define nh5aget_info_c H5_FC_FUNC_(h5aget_info_c,H5AGET_INFO_C) /* MSB */ +# define nh5aget_info_by_idx_c H5_FC_FUNC_(h5aget_info_by_idx_c,H5AGET_INFO_BY_IDX_C) /* MSB */ +# define nh5aget_info_by_name_c H5_FC_FUNC_(h5aget_info_by_name_c,H5AGET_INFO_BY_NAME_C) /* MSB */ +# define nh5aget_info_by_name_c H5_FC_FUNC_(h5aget_info_by_name_c,H5AGET_INFO_BY_NAME_C) /* MSB */ +# define nh5acreate_by_name_c H5_FC_FUNC_(h5acreate_by_name_c,H5ACREATE_BY_NAME_C) /* MSB */ +# define nh5aexists_c H5_FC_FUNC_(h5aexists_c,H5AEXISTS_C) /* MSB */ +# define nh5aexists_by_name_c H5_FC_FUNC_(h5aexists_by_name_c,H5AEXISTS_BY_NAME_C) /* MSB */ +# define nh5aopen_by_name_c H5_FC_FUNC_(h5aopen_by_name_c,H5AOPEN_BY_NAME_C) /* MSB */ +# define nh5arename_c H5_FC_FUNC_(h5arename_c,H5ARENAME_C) /* MSB */ - -H5_FCDLL int_f nh5acreate_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *attr_id); +H5_FCDLL int_f nh5acreate_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *type_id, hid_t_f *space_id, hid_t_f *crt_prp, hid_t_f *aapl, hid_t_f *attr_id); H5_FCDLL int_f nh5aopen_name_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *attr_id); H5_FCDLL int_f nh5awritec_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf, void *dims); H5_FCDLL int_f nh5awritec_s_c (hid_t_f *attr_id, hid_t_f *mem_type_id, _fcd buf, void *dims); @@ -523,6 +562,45 @@ H5_FCDLL int_f nh5aget_space_c (hid_t_f *attr_id, hid_t_f *space_id); H5_FCDLL int_f nh5aget_type_c (hid_t_f *attr_id, hid_t_f *type_id); H5_FCDLL int_f nh5aget_num_attrs_c (hid_t_f *obj_id, int_f *attr_num); H5_FCDLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf); +H5_FCDLL int_f nh5aget_storage_size_c ( hid_t_f *attr_id, hsize_t_f *size ); /* MSB */ +H5_FCDLL int_f nh5arename_by_name_c ( hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd old_attr_name, size_t_f *old_attr_namelen, + _fcd new_attr_name, size_t_f *new_attr_namelen, + hid_t_f *lapl_id ); /* MSB */ +H5_FCDLL int_f nh5aopen_c ( hid_t_f *obj_id, _fcd attr_name, size_t_f *attr_namelen, + hid_t_f *aapl_id, hid_t_f *attr_id); /* MSB */ +H5_FCDLL int_f nh5adelete_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd attr_name, size_t_f *attr_namelen, hid_t_f *lapl_id); /* MSB */ +H5_FCDLL int_f nh5adelete_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *lapl_id); /* MSB */ +H5_FCDLL int_f nh5aget_name_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, _fcd name, + size_t_f *size, hid_t_f *lapl_id); /* MSB */ +H5_FCDLL int_f nh5aget_create_plist_c ( hid_t_f *attr_id, hid_t_f *creation_prop_id ); /* MSB */ +H5_FCDLL int_f nh5aopen_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *aapl_id, hid_t_f *lapl_id, hid_t_f *attr_id); /* MSB */ +H5_FCDLL int_f nh5aget_info_c (hid_t_f *loc_id, int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ); /* MSB */ +H5_FCDLL int_f nh5aget_info_by_idx_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + int_f *idx_type, int_f *order, size_t_f *n, hid_t_f *lapl_id, + int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ); /* MSB */ +H5_FCDLL int_f nh5aget_info_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd attr_name, size_t_f *attr_namelen, hid_t_f *lapl_id, + int_f *corder_valid, int_f *corder, + int_f *cset, hsize_t_f *data_size ); /* MSB */ +H5_FCDLL int_f nh5acreate_by_name_c(hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, + _fcd attr_name, size_t_f *attr_namelen, hid_t_f *type_id, + hid_t_f *space_id, hid_t_f *acpl_id, hid_t_f *aapl_id, + hid_t_f *lapl_id, hid_t_f *attr_id ); /* MSB */ +H5_FCDLL int_f nh5aexists_c (hid_t_f *obj_id, _fcd name, size_t_f *namelen, hid_t_f *attr_exists); /* MSB */ +H5_FCDLL int_f nh5aexists_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, + hid_t_f *lapl_id, hid_t_f *attr_exists); /* MSB */ +H5_FCDLL int_f nh5aopen_by_name_c (hid_t_f *loc_id, _fcd obj_name, size_t_f *obj_namelen, _fcd attr_name, size_t_f *attr_namelen, + hid_t_f *aapl_id, hid_t_f *lapl_id, hid_t_f *attr_id); /* MSB */ +H5_FCDLL int_f nh5arename_c( hid_t_f *loc_id, + _fcd old_attr_name, size_t_f *old_attr_namelen, + _fcd new_attr_name, size_t_f *new_attr_namelen); /* MSB */ /* * Functions form H5Tf.c file @@ -583,11 +661,15 @@ H5_FCDLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf); # define nh5tvlen_create_c H5_FC_FUNC_(h5tvlen_create_c, H5TVLEN_CREATE_C) # define nh5tis_variable_str_c H5_FC_FUNC_(h5tis_variable_str_c, H5TIS_VARIABLE_STR_C) # define nh5tget_member_class_c H5_FC_FUNC_(h5tget_member_class_c, H5TGET_MEMBER_CLASS_C) - +# define nh5tcommit_anon_c H5_FC_FUNC_(h5tcommit_anon_c, H5TCOMMIT_ANON_C) +# define nh5tdecode_c H5_FC_FUNC_(h5tdecode_c, H5TDECODE_C) +# define nh5tencode_c H5_FC_FUNC_(h5tencode_c, H5TENCODE_C) +# define nh5tget_create_plist_c H5_FC_FUNC_(h5tget_create_plist_c, H5TGET_CREATE_PLIST_C) +# define nh5tcompiler_conv_c H5_FC_FUNC_(h5tcompiler_conv_c, H5TCOMPILER_CONV_C) H5_FCDLL int_f nh5tcreate_c(int_f *class, size_t_f *size, hid_t_f *type_id); -H5_FCDLL int_f nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id); -H5_FCDLL int_f nh5tcommit_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id); +H5_FCDLL int_f nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *tapl_id ); +H5_FCDLL int_f nh5tcommit_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *lcpl_id, hid_t_f *tcpl_id, hid_t_f *tapl_id); H5_FCDLL int_f nh5tclose_c ( hid_t_f *type_id ); H5_FCDLL int_f nh5tequal_c ( hid_t_f *type1_id , hid_t_f *type2_id, int_f *c_flag); H5_FCDLL int_f nh5tcopy_c ( hid_t_f *type_id , hid_t_f *new_type_id); @@ -596,7 +678,7 @@ H5_FCDLL int_f nh5tget_order_c ( hid_t_f *type_id , int_f *order); H5_FCDLL int_f nh5tset_order_c ( hid_t_f *type_id , int_f *order); H5_FCDLL int_f nh5tget_size_c ( hid_t_f *type_id , size_t_f *size); H5_FCDLL int_f nh5tset_size_c ( hid_t_f *type_id , size_t_f *size); -H5_FCDLL int_f nh5tcommitted_c (hid_t_f *type_id); +H5_FCDLL int_f nh5tcommitted_c (hid_t_f *dtype_id); H5_FCDLL int_f nh5tget_precision_c ( hid_t_f *type_id , size_t_f *precision); H5_FCDLL int_f nh5tset_precision_c ( hid_t_f *type_id , size_t_f *precision); H5_FCDLL int_f nh5tget_offset_c ( hid_t_f *type_id , size_t_f *offset); @@ -641,7 +723,24 @@ H5_FCDLL int_f nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id); H5_FCDLL int_f nh5tvlen_create_c ( hid_t_f *type_id , hid_t_f *vltype_id); H5_FCDLL int_f nh5tis_variable_str_c ( hid_t_f *type_id , int_f *flag ); H5_FCDLL int_f nh5tget_member_class_c ( hid_t_f *type_id , int_f *member_no, int_f *class ); +H5_FCDLL int_f nh5tcommit_anon_c(hid_t_f *loc_id, hid_t_f *dtype_id, hid_t_f *tcpl_id, hid_t_f *tapl_id); +H5_FCDLL int_f nh5tdecode_c ( _fcd buf, int_f *obj_id ); +H5_FCDLL int_f nh5tencode_c (_fcd buf, hid_t_f *obj_id, size_t_f *nalloc ); +H5_FCDLL int_f nh5tget_create_plist_c ( hid_t_f *dtype_id, hid_t_f *dtpl_id); +H5_FCDLL int_f nh5tcompiler_conv_c ( hid_t_f *src_id, hid_t_f *dst_id, int_f *c_flag); + + +/* + * Functions from H5Of.c + */ + +# define nh5olink_c H5_FC_FUNC_(h5olink_c, H5OLINK_C) +# define nh5oopen_c H5_FC_FUNC_(h5oopen_c, H5OOPEN_C) + +H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id); +H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, size_t_f *namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id); /* * Functions from H5Pf.c */ @@ -768,7 +867,37 @@ H5_FCDLL int_f nh5tget_member_class_c ( hid_t_f *type_id , int_f *member_no, in # define nh5pset_fapl_multi_sc H5_FC_FUNC_(h5pset_fapl_multi_sc, H5PSET_FAPL_MULTI_SC) # define nh5pset_szip_c H5_FC_FUNC_(h5pset_szip_c, H5PSET_SZIP_C) # define nh5pall_filters_avail_c H5_FC_FUNC_(h5pall_filters_avail_c, H5PALL_FILTERS_AVAIL_C) - +# define nh5pget_attr_phase_change_c H5_FC_FUNC_(h5pget_attr_phase_change_c, H5PGET_ATTR_PHASE_CHANGE_C) /* MSB */ +# define nh5pset_attr_creation_order_c H5_FC_FUNC_(h5pset_attr_creation_order_c, H5PSET_ATTR_CREATION_ORDER_C) /* MSB */ +# define nh5pset_shared_mesg_nindexes_c H5_FC_FUNC_(h5pset_shared_mesg_nindexes_c, H5PSET_SHARED_MESG_NINDEXES_C) /* MSB */ +# define nh5pset_shared_mesg_index_c H5_FC_FUNC_(h5pset_shared_mesg_index_c,H5PSET_SHARED_MESG_INDEX_C) /* MSB */ +# define nh5pget_attr_creation_order_c H5_FC_FUNC_(h5pget_attr_creation_order_c,H5PGET_ATTR_CREATION_ORDER_C) /* MSB */ +# define nh5pset_libver_bounds_c H5_FC_FUNC_(h5pset_libver_bounds_c,H5PSET_LIBVER_BOUNDS_C) /* MSB */ +# define nh5pset_link_creation_order_c H5_FC_FUNC_(h5pset_link_creation_order_c, H5PSET_LINK_CREATION_ORDER_C) /* MSB */ +# define nh5pget_link_phase_change_c H5_FC_FUNC_(h5pget_link_phase_change_c, H5PGET_LINK_PHASE_CHANGE_C) /* MSB */ +# define nh5pget_obj_track_times_c H5_FC_FUNC_(h5pget_obj_track_times_c, H5PGET_OBJ_TRACK_TIMES_C) /* MSB */ +# define nh5pset_obj_track_times_c H5_FC_FUNC_(h5pset_obj_track_times_c, H5PSET_OBJ_TRACK_TIMES_C) /* MSB */ +# define nh5pset_create_inter_group_c H5_FC_FUNC_(h5pset_create_inter_group_c,H5PSET_CREATE_INTER_GROUP_C) /* MSB */ +# define nh5pget_create_inter_group_c H5_FC_FUNC_(h5pget_create_inter_group_c,H5PGET_CREATE_INTER_GROUP_C) /* MSB */ +# define nh5pget_link_creation_order_c H5_FC_FUNC_(h5pget_link_creation_order_c,H5PGET_LINK_CREATION_ORDER_C) /* MSB */ +# define nh5pset_char_encoding_c H5_FC_FUNC_(h5pset_char_encoding_c, H5PSET_CHAR_ENCODING_C) /* MSB */ +# define nh5pget_char_encoding_c H5_FC_FUNC_(h5pget_char_encoding_c, H5PGET_CHAR_ENCODING_C) /* MSB */ +# define nh5pset_copy_object_c H5_FC_FUNC_(h5pset_copy_object_c, H5PSET_COPY_OBJECT_C) /* MSB */ +# define nh5pget_copy_object_c H5_FC_FUNC_(h5pget_copy_object_c, H5PGET_COPY_OBJECT_C) /* MSB */ +# define nh5pget_data_transform_c H5_FC_FUNC_(h5pget_data_transform_c, H5PGET_DATA_TRANSFORM_C) /* MSB */ +# define nh5pset_data_transform_c H5_FC_FUNC_(h5pset_data_transform_c, H5PSET_DATA_TRANSFORM_C) /* MSB */ +# define nh5pget_local_heap_size_hint_c H5_FC_FUNC_(h5pget_local_heap_size_hint_c, H5PGET_LOCAL_HEAP_SIZE_HINT_C) /* MSB */ +# define nh5pget_est_link_info_c H5_FC_FUNC_(h5pget_est_link_info_c,H5PGET_EST_LINK_INFO_C) /* MSB */ +# define nh5pset_est_link_info_c H5_FC_FUNC_(h5pset_est_link_info_c,H5PSET_EST_LINK_INFO_C) /* MSB */ +# define nh5pset_local_heap_size_hint_c H5_FC_FUNC_(h5pset_local_heap_size_hint_c, H5PSET_LOCAL_HEAP_SIZE_HINT_C) /* MSB */ +# define nh5pset_link_phase_change_c H5_FC_FUNC_(h5pset_link_phase_change_c, H5PSET_LINK_PHASE_CHANGE_C) /* MSB */ +# define nh5pset_fapl_direct_c H5_FC_FUNC_(h5pset_fapl_direct_c, H5PSET_FAPL_DIRECT_C) /* MSB */ +# define nh5pget_fapl_direct_c H5_FC_FUNC_(h5pget_fapl_direct_c, H5PGET_FAPL_DIRECT_C) /* MSB */ +# define nh5pset_attr_phase_change_c H5_FC_FUNC_(h5pset_attr_phase_change_c, H5PSET_ATTR_PHASE_CHANGE_C) /* MSB */ +# define nh5pset_nbit_c H5_FC_FUNC_(h5pset_nbit_c, H5PSET_NBIT_C) /* MSB */ +# define nh5pset_scaleoffset_c H5_FC_FUNC_(h5pset_scaleoffset_c, H5PSET_SCALEOFFSET_C) /* MSB */ +# define nh5pset_nlinks_c H5_FC_FUNC_(h5pset_nlinks_c, H5PSET_NLINKS_C) /* MSB */ +# define nh5pget_nlinks_c H5_FC_FUNC_(h5pget_nlinks_c, H5PGET_NLINKS_C) /* MSB */ H5_FCDLL int_f nh5pcreate_c ( hid_t_f *class, hid_t_f *prp_id ); H5_FCDLL int_f nh5pclose_c ( hid_t_f *prp_id ); @@ -894,7 +1023,37 @@ H5_FCDLL int_f nh5pset_fapl_multi_sc ( hid_t_f *prp_id , int_f *flag); H5_FCDLL int_f nh5pset_szip_c ( hid_t_f *prp_id , int_f *options_mask, int_f *pixels_per_block); H5_FCDLL int_f nh5pall_filters_avail_c ( hid_t_f *prp_id , int_f *status); H5_FCDLL int_f nh5pfill_value_defined_c ( hid_t_f *prp_id , int_f *flag); - +H5_FCDLL int_f nh5pget_attr_phase_change_c (hid_t_f *ocpl_id, int_f *max_compact, int_f *min_dense ); /* MSB */ +H5_FCDLL int_f nh5pset_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags ); /* MSB */ +H5_FCDLL int_f nh5pset_shared_mesg_nindexes_c(hid_t_f *plist_id, int_f *nindexes ); /* MSB */ +H5_FCDLL int_f nh5pset_shared_mesg_index_c(hid_t_f *fcpl_id, int_f *index_num, int_f *mesg_type_flags, int_f *min_mesg_size); /* MSB */ +H5_FCDLL int_f nh5pget_attr_creation_order_c(hid_t_f *ocpl_id, int_f *crt_order_flags); /* MSB */ +H5_FCDLL int_f nh5pset_libver_bounds_c(hid_t_f *fapl_id, int_f *low, int_f *high); /* MSB */ +H5_FCDLL int_f nh5pset_link_creation_order_c(hid_t_f *gcpl_id, int_f *crt_order_flags); /* MSB */ +H5_FCDLL int_f nh5pget_link_phase_change_c(hid_t_f *gcpl_id, int_f *max_compact, int_f *min_dense ); /* MSB */ +H5_FCDLL int_f nh5pget_obj_track_times_c(hid_t_f *plist_id, int_f *flag); /* MSB */ +H5_FCDLL int_f nh5pset_obj_track_times_c(hid_t_f *plist_id, int_f *flag); /* MSB */ +H5_FCDLL int_f nh5pset_create_inter_group_c(hid_t_f *lcpl_id, int_f *crt_intermed_group); /* MSB */ +H5_FCDLL int_f nh5pget_create_inter_group_c(hid_t_f *lcpl_id, int_f *crt_intermed_group); /* MSB */ +H5_FCDLL int_f nh5pget_link_creation_order_c(hid_t_f *gcpl_id, int_f *crt_order_flags); /* MSB */ +H5_FCDLL int_f nh5pset_char_encoding_c(hid_t_f *plist_id, int_f *encoding); /* MSB */ +H5_FCDLL int_f nh5pget_char_encoding_c(hid_t_f *plist_id, int_f *encoding); /* MSB */ +H5_FCDLL int_f nh5pset_copy_object_c(hid_t_f *ocp_plist_id, int_f *copy_options); /* MSB */ +H5_FCDLL int_f nh5pget_copy_object_c(hid_t_f *ocp_plist_id, int_f *copy_options); /* MSB */ +H5_FCDLL int_f nh5pget_data_transform_c(hid_t_f *plist_id, _fcd expression, int_f *expression_len, size_t_f *size); /* MSB */ +H5_FCDLL int_f nh5pset_data_transform_c(hid_t_f *plist_id, _fcd expression, int_f *expression_len); /* MSB */ +H5_FCDLL int_f nh5pget_local_heap_size_hint_c(hid_t_f *gcpl_id, size_t_f *size_hint); /* MSB */ +H5_FCDLL int_f nh5pget_est_link_info_c(hid_t_f *gcpl_id, int_f *est_num_entries, int_f *est_name_len); /* MSB */ +H5_FCDLL int_f nh5pset_local_heap_size_hint_c(hid_t_f *gcpl_id, size_t_f *size_hint); /* MSB */ +H5_FCDLL int_f nh5pset_est_link_info_c(hid_t_f *gcpl_id, int_f *est_num_entries, int_f *est_name_len); /* MSB */ +H5_FCDLL int_f nh5pset_link_phase_change_c(hid_t_f *gcpl_id, int_f *max_compact, int_f *min_dense ); /* MSB */ +H5_FCDLL int_f nh5pset_fapl_direct_c(hid_t_f *fapl_id, size_t_f *alignment, size_t_f *block_size, size_t_f *cbuf_size ); /* MSB */ +H5_FCDLL int_f nh5pget_fapl_direct_c(hid_t_f *fapl_id, size_t_f *alignment, size_t_f *block_size, size_t_f *cbuf_size ); /* MSB */ +H5_FCDLL int_f nh5pset_attr_phase_change_c (hid_t_f *ocpl_id, int_f *max_compact, int_f *min_dense ); /* MSB */ +H5_FCDLL int_f nh5pset_nbit_c(hid_t_f *plist_id ); /* MSB */ +H5_FCDLL int_f nh5pset_scaleoffset_c(hid_t_f *plist_id, int_f *scale_type, int_f *scale_factor ); /* MSB */ +H5_FCDLL int_f nh5pset_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); /* MSB */ +H5_FCDLL int_f nh5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); /* MSB */ /* * Functions frome H5Rf.c */ @@ -904,6 +1063,8 @@ H5_FCDLL int_f nh5pfill_value_defined_c ( hid_t_f *prp_id , int_f *flag); # define nh5rdereference_object_c H5_FC_FUNC_(h5rdereference_object_c, H5RDEREFERENCE_OBJECT_C) # define nh5rget_region_region_c H5_FC_FUNC_(h5rget_region_region_c, H5RGET_REGION_REGION_C) # define nh5rget_object_type_obj_c H5_FC_FUNC_(h5rget_object_type_obj_c, H5RGET_OBJECT_TYPE_OBJ_C) +# define nh5rget_name_object_c H5_FC_FUNC_(h5rget_name_object_c, H5RGET_NAME_OBJECT_C) +# define nh5rget_name_region_c H5_FC_FUNC_(h5rget_name_region_c, H5RGET_NAME_REGION_C) H5_FCDLL int_f nh5rcreate_object_c (haddr_t_f *ref, hid_t_f *loc_id, _fcd name, int_f *namelen); @@ -912,7 +1073,8 @@ H5_FCDLL int_f nh5rdereference_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f * H5_FCDLL int_f nh5rdereference_object_c (hid_t_f *dset_id, haddr_t_f *ref, hid_t_f *obj_id); H5_FCDLL int_f nh5rget_region_region_c (hid_t_f *dset_id, int_f *ref, hid_t_f *space_id); H5_FCDLL int_f nh5rget_object_type_obj_c (hid_t_f *dset_id, haddr_t_f *ref, int_f *obj_type); - +H5_FCDLL int_f nh5rget_name_object_c (hid_t_f *loc_id, haddr_t_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); +H5_FCDLL int_f nh5rget_name_region_c (hid_t_f *loc_id, int_f *ref, _fcd name, size_t_f *name_len, size_t_f *size_default); /* * Functions from H5If.c */ @@ -968,10 +1130,10 @@ H5_FCDLL int_f nh5close_c(void); H5_FCDLL int_f nh5init_types_c(hid_t_f *types, hid_t_f * floatingtypes, hid_t_f * integertypes); H5_FCDLL 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); H5_FCDLL int_f nh5init_flags_c( int_f *h5d_flags, int_f *h5f_flags, - int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, - int_f *h5g_flags, int_f *h5i_flags, - hid_t_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, - int_f *h5t_flags, int_f *h5z_flags); + int_f *h5fd_flags, hid_t_f *h5fd_hid_flags, + int_f *h5g_flags, int_f *h5i_flags, int_f *h5l_flags, int_f *h5o_flags, + hid_t_f *h5p_flags, int_f *h5r_flags, int_f *h5s_flags, + int_f *h5t_flags, int_f *h5z_flags, int_f *h5_generic_flags); H5_FCDLL int_f nh5init1_flags_c(int_f *h5lib_flags); H5_FCDLL int_f nh5get_libversion_c(int_f *majnum, int_f *minnum, int_f *relnum); H5_FCDLL int_f nh5check_version_c(int_f *majnum, int_f *minnum, int_f *relnum); @@ -991,4 +1153,55 @@ H5_FCDLL int_f nh5zfilter_avail_c (int_f *filter, int_f *flag); H5_FCDLL int_f nh5zget_filter_info_c (int_f *filter, int_f *flag); +/* + * Functions from H5Lf.c + */ +# define nh5lcopy_c H5_FC_FUNC_(h5lcopy_c, H5LCOPY_C) /*MSB*/ +# define nh5lcreate_external_c H5_FC_FUNC_(h5lcreate_external_c, H5LCREATE_EXTERNAL_C) /*MSB*/ +# define nh5lcreate_hard_c H5_FC_FUNC_(h5lcreate_hard_c, H5LCREATE_HARD_C) /*MSB*/ +# define nh5lcreate_soft_c H5_FC_FUNC_(h5lcreate_soft_c, H5LCREATE_SOFT_C) /*MSB*/ +# define nh5ldelete_c H5_FC_FUNC_(h5ldelete_c, H5LDELETE_C) /*MSB*/ +# define nh5ldelete_by_idx_c H5_FC_FUNC_(h5ldelete_by_idx_c, H5LDELETE_BY_IDX_C) /*MSB*/ +# define nh5lexists_c H5_FC_FUNC_(h5lexists_c, H5LEXISTS_C) /*MSB*/ +# define nh5lget_info_c H5_FC_FUNC_(h5lget_info_c, H5LGET_INFO_C) /*MSB*/ +# define nh5lget_info_by_idx_c H5_FC_FUNC_(h5lget_info_by_idx_c, H5LGET_INFO_BY_IDX_C) /*MSB*/ +# define nh5lis_registered_c H5_FC_FUNC_(h5lis_registered_c, H5LIS_REGISTERED_C) /*MSB*/ +# define nh5lmove_c H5_FC_FUNC_(h5lmove_c, H5LMOVE_C) /* MSB */ +# define nh5lget_name_by_idx_c H5_FC_FUNC_(h5lget_name_by_idx_c, H5LGET_NAME_BY_IDX_C) /* MSB */ +# define nh5lget_val_c H5_FC_FUNC_(h5lget_val_c, H5LGET_VAL_C) /* MSB */ + +H5_FCDLL int_f nh5lcopy_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, + _fcd dest_name, size_t_f *dest_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lcreate_external_c(_fcd file_name, size_t_f *file_namelen, _fcd obj_name, size_t_f *obj_namelen, + hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lcreate_hard_c(hid_t_f *obj_loc_id, _fcd obj_name, size_t_f *obj_namelen, + hid_t_f *link_loc_id, + _fcd link_name, size_t_f *link_namelen, + hid_t_f *lcpl_id, hid_t_f *lapl_id ); /*MSB*/ +H5_FCDLL int_f nh5lcreate_soft_c(_fcd target_path, size_t_f *target_path_len, + hid_t_f *link_loc_id, + _fcd link_name, size_t_f *link_name_len, + hid_t_f *lcpl_id, hid_t_f *lapl_id ); /*MSB*/ +H5_FCDLL int_f nh5ldelete_c( hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id ); /*MSB*/ +H5_FCDLL int_f nh5ldelete_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, size_t_f *n, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lexists_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *link_exists); /*MSB*/ +H5_FCDLL int_f nh5lget_info_c (hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, + int_f *cset, int_f *corder, int_f *corder_valid, int_f *link_type, + int_f *address, hsize_t_f *link_len, + hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lget_info_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, hsize_t_f *n, + int_f *corder_valid, int_f *corder, int_f *cset, hsize_t_f *data_size, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lis_registered_c(int_f *link_cls_id); /*MSB*/ +H5_FCDLL int_f nh5lmove_c(hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_namelen, hid_t_f *dest_loc_id, + _fcd dest_name, size_t_f *dest_namelen, hid_t_f *lcpl_id, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lget_name_by_idx_c(hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen, + int_f *index_field, int_f *order, hsize_t_f *n, + size_t_f *size, _fcd name, hid_t_f *lapl_id); /*MSB*/ +H5_FCDLL int_f nh5lget_val_c(hid_t_f *link_loc_id, _fcd link_name, size_t_f *link_namelen, size_t_f *size, + void *linkval_buff, hid_t_f *lapl_id) ; + #endif /* _H5f90proto_H */ diff --git a/fortran/src/HDF5.f90 b/fortran/src/HDF5.f90 index b24d295..04ad33d 100644 --- a/fortran/src/HDF5.f90 +++ b/fortran/src/HDF5.f90 @@ -13,18 +13,21 @@ ! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! - MODULE HDF5 - USE H5GLOBAL - USE H5F - USE H5G - USE H5E - USE H5I - USE H5S - USE H5D - USE H5A - USE H5T - USE H5P - USE H5R - USE H5Z - USE H5LIB - END MODULE HDF5 +MODULE HDF5 + USE H5GLOBAL + USE H5F + USE H5G + USE H5E + USE H5I + USE H5L + USE H5S + USE H5D + USE H5A + USE H5T + USE H5O + USE H5P + USE H5R + USE H5Z + USE H5LIB + +END MODULE HDF5 diff --git a/fortran/src/HDF5mpio.f90 b/fortran/src/HDF5mpio.f90 index 95c6273..59ec309 100644 --- a/fortran/src/HDF5mpio.f90 +++ b/fortran/src/HDF5mpio.f90 @@ -19,10 +19,12 @@ USE H5E USE H5G USE H5I + USE H5L USE H5S USE H5D USE H5A USE H5T + USE H5O USE H5P USE H5FDMPIO USE H5R diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index a4f9025..4216f34 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -48,10 +48,10 @@ endif # Source files for the library. libhdf5_fortran_la_SOURCES=H5fortran_flags.f90 H5f90global.f90 \ H5fortran_types.f90 H5_ff.f90 H5Aff.f90 H5Dff.f90 H5Eff.f90 \ - H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Pff.f90 H5Rff.f90 H5Sff.f90 \ + H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Lff.f90 H5Off.f90 H5Pff.f90 H5Rff.f90 H5Sff.f90 \ H5Tff.f90 H5Zff.f90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ - H5If.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \ + H5If.c H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \ $(PARALLEL_COND_SRC) # h5fc and libhdf5_fortran.settings are generated during configure. @@ -167,17 +167,19 @@ H5Eff.lo: $(srcdir)/H5Eff.f90 H5f90global.lo H5Fff.lo: $(srcdir)/H5Fff.f90 H5f90global.lo H5Gff.lo: $(srcdir)/H5Gff.f90 H5f90global.lo H5Iff.lo: $(srcdir)/H5Iff.f90 H5f90global.lo +H5Lff.lo: $(srcdir)/H5Lff.f90 H5f90global.lo +H5Off.lo: $(srcdir)/H5Off.f90 H5f90global.lo H5Pff.lo: $(srcdir)/H5Pff.f90 H5f90global.lo H5Rff.lo: $(srcdir)/H5Rff.f90 H5f90global.lo H5Sff.lo: $(srcdir)/H5Sff.f90 H5f90global.lo H5Tff.lo: $(srcdir)/H5Tff.f90 H5f90global.lo H5Zff.lo: $(srcdir)/H5Zff.f90 H5f90global.lo HDF5.lo: $(srcdir)/HDF5.f90 H5f90global.lo H5Aff.lo \ - H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo \ + H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo \ H5Pff.lo H5Rff.lo H5Sff.lo H5Tff.lo H5Zff.lo H5FDmpioff.lo: $(srcdir)/H5FDmpioff.f90 H5f90global.lo HDF5mpio.lo: $(srcdir)/H5FDmpioff.f90 H5f90global.lo H5Aff.lo \ - H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo \ + H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo \ H5Pff.lo H5Rff.lo H5Sff.lo H5Tff.lo H5Zff.lo H5FDmpioff.lo include $(top_srcdir)/config/conclude.am diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in index 31baee2..a51254a 100644 --- a/fortran/src/Makefile.in +++ b/fortran/src/Makefile.in @@ -78,19 +78,20 @@ LTLIBRARIES = $(lib_LTLIBRARIES) libhdf5_fortran_la_LIBADD = am__libhdf5_fortran_la_SOURCES_DIST = H5fortran_flags.f90 \ H5f90global.f90 H5fortran_types.f90 H5_ff.f90 H5Aff.f90 \ - H5Dff.f90 H5Eff.f90 H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Pff.f90 \ - H5Rff.f90 H5Sff.f90 H5Tff.f90 H5Zff.f90 H5f90kit.c H5_f.c \ - H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c H5If.c H5Pf.c H5Rf.c H5Sf.c \ - H5Tf.c H5Zf.c HDF5.f90 H5FDmpiof.c HDF5mpio.f90 H5FDmpioff.f90 + H5Dff.f90 H5Eff.f90 H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Lff.f90 \ + H5Off.f90 H5Pff.f90 H5Rff.f90 H5Sff.f90 H5Tff.f90 H5Zff.f90 \ + H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c H5If.c \ + H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c HDF5.f90 \ + H5FDmpiof.c HDF5mpio.f90 H5FDmpioff.f90 @BUILD_PARALLEL_CONDITIONAL_FALSE@am__objects_1 = HDF5.lo @BUILD_PARALLEL_CONDITIONAL_TRUE@am__objects_1 = H5FDmpiof.lo \ @BUILD_PARALLEL_CONDITIONAL_TRUE@ HDF5mpio.lo H5FDmpioff.lo am_libhdf5_fortran_la_OBJECTS = H5fortran_flags.lo H5f90global.lo \ H5fortran_types.lo H5_ff.lo H5Aff.lo H5Dff.lo H5Eff.lo \ - H5Fff.lo H5Gff.lo H5Iff.lo H5Pff.lo H5Rff.lo H5Sff.lo H5Tff.lo \ - H5Zff.lo H5f90kit.lo H5_f.lo H5Af.lo H5Df.lo H5Ef.lo H5Ff.lo \ - H5Gf.lo H5If.lo H5Pf.lo H5Rf.lo H5Sf.lo H5Tf.lo H5Zf.lo \ - $(am__objects_1) + H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo H5Off.lo H5Pff.lo H5Rff.lo \ + H5Sff.lo H5Tff.lo H5Zff.lo H5f90kit.lo H5_f.lo H5Af.lo H5Df.lo \ + H5Ef.lo H5Ff.lo H5Gf.lo H5If.lo H5Lf.lo H5Of.lo H5Pf.lo \ + H5Rf.lo H5Sf.lo H5Tf.lo H5Zf.lo $(am__objects_1) libhdf5_fortran_la_OBJECTS = $(am_libhdf5_fortran_la_OBJECTS) PROGRAMS = $(noinst_PROGRAMS) am_H5fortran_detect_OBJECTS = H5fortran_detect.$(OBJEXT) @@ -381,10 +382,10 @@ lib_LTLIBRARIES = libhdf5_fortran.la # Source files for the library. libhdf5_fortran_la_SOURCES = H5fortran_flags.f90 H5f90global.f90 \ H5fortran_types.f90 H5_ff.f90 H5Aff.f90 H5Dff.f90 H5Eff.f90 \ - H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Pff.f90 H5Rff.f90 H5Sff.f90 \ + H5Fff.f90 H5Gff.f90 H5Iff.f90 H5Lff.f90 H5Off.f90 H5Pff.f90 H5Rff.f90 H5Sff.f90 \ H5Tff.f90 H5Zff.f90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ - H5If.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \ + H5If.c H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \ $(PARALLEL_COND_SRC) @@ -536,6 +537,8 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Ff.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Gf.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5If.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Lf.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Of.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Pf.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Rf.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/H5Sf.Plo@am__quote@ @@ -869,17 +872,19 @@ H5Eff.lo: $(srcdir)/H5Eff.f90 H5f90global.lo H5Fff.lo: $(srcdir)/H5Fff.f90 H5f90global.lo H5Gff.lo: $(srcdir)/H5Gff.f90 H5f90global.lo H5Iff.lo: $(srcdir)/H5Iff.f90 H5f90global.lo +H5Lff.lo: $(srcdir)/H5Lff.f90 H5f90global.lo +H5Off.lo: $(srcdir)/H5Off.f90 H5f90global.lo H5Pff.lo: $(srcdir)/H5Pff.f90 H5f90global.lo H5Rff.lo: $(srcdir)/H5Rff.f90 H5f90global.lo H5Sff.lo: $(srcdir)/H5Sff.f90 H5f90global.lo H5Tff.lo: $(srcdir)/H5Tff.f90 H5f90global.lo H5Zff.lo: $(srcdir)/H5Zff.f90 H5f90global.lo HDF5.lo: $(srcdir)/HDF5.f90 H5f90global.lo H5Aff.lo \ - H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo \ + H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo \ H5Pff.lo H5Rff.lo H5Sff.lo H5Tff.lo H5Zff.lo H5FDmpioff.lo: $(srcdir)/H5FDmpioff.f90 H5f90global.lo HDF5mpio.lo: $(srcdir)/H5FDmpioff.f90 H5f90global.lo H5Aff.lo \ - H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo \ + H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.lo H5Lff.lo \ H5Pff.lo H5Rff.lo H5Sff.lo H5Tff.lo H5Zff.lo H5FDmpioff.lo # lib/progs/tests targets recurse into subdirectories. build-* targets diff --git a/fortran/src/README_DEVELOPEMENT b/fortran/src/README_DEVELOPEMENT new file mode 100644 index 0000000..dc65f47 --- /dev/null +++ b/fortran/src/README_DEVELOPEMENT @@ -0,0 +1,36 @@ +Procedure to add a new function: + +(1) Edit the fortran/src/H5*ff.f90 file +(2) Edit the fortran/sr/H5*f.c file +(3) Edit the fortran/src/H5f90proto.h file + + + +Procedure: +(1) Find the struct name you are interested in: + (a) src/H5public.h if it is a generic type, i.e. H5_* + or + (b) src/H5*public.h if is a specific type, i.e. H5*_ + +(2) Put that structure into an array that will be passed to fortran in: + (a) fortran/src/H5_f.c (add to nh5init_flags_c subroutine) + (b) edit fortran/src/H5f90proto.h and edit nh5init_flags_c interface call + +(3) Edit the function call in fortran/src/H5_ff.f90 + (a) edit the call FUNCTION h5init_flags_c + (b) edit h5init_flags_c call in h5open_f to match the number of arguments passing + +(4) add the size of the array and array to fortran/src/H5f90global.f90 + - must match the size found it H5_f.c + +NOTE: To just add a default C value argument, do steps (2a) and (4) + +Adding a new file to the repository +------------------------------------- + +Add the name of the file to: + (1) Makefile.am located in the same directory as the newfile + (2) MANIFEST located in the top level directory + + +If you add a new file, be sure to add it to the MANIFEST located in the top directory diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index ed4b9fd..042cfab 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -36,12 +36,10 @@ else endif # Our main targets, the tests themselves -TEST_PROG=fortranlib_test fflush1 fflush2 +TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8 check_PROGRAMS=$(TEST_PROG) -libh5test_fortran_la_SOURCES=fortranlib_test.f90 tH5F.f90 tH5D.f90 \ - tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 tH5Sselect.f90 \ - tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 t.c +libh5test_fortran_la_SOURCES= tf.f90 t.c # Source files are used for both the library and fortranlib_test. # Automake will complain about this without the following workaround. @@ -50,8 +48,12 @@ fortranlib_test_CFLAGS=$(AM_CFLAGS) fortranlib_test_SOURCES = fortranlib_test.f90 \ tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \ - tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 \ - t.c + tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 + +fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ + tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \ + tH5Sselect.f90 tH5O.f90 tH5P.f90 tH5A_1_8.f90 tH5I.f90 tH5G_1_8.f90 tH5E.f90 + fflush1_SOURCES=fflush1.f90 fflush2_SOURCES=fflush2.f90 diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in index 5e0b92f..3c748e9 100644 --- a/fortran/test/Makefile.in +++ b/fortran/test/Makefile.in @@ -64,12 +64,10 @@ CONFIG_HEADER = $(top_builddir)/src/H5config.h CONFIG_CLEAN_FILES = LTLIBRARIES = $(noinst_LTLIBRARIES) libh5test_fortran_la_LIBADD = -am_libh5test_fortran_la_OBJECTS = fortranlib_test.lo tH5F.lo tH5D.lo \ - tH5R.lo tH5S.lo tH5T.lo tH5VL.lo tH5Z.lo tH5Sselect.lo tH5P.lo \ - tH5A.lo tH5I.lo tH5G.lo tH5E.lo tf.lo t.lo +am_libh5test_fortran_la_OBJECTS = tf.lo t.lo libh5test_fortran_la_OBJECTS = $(am_libh5test_fortran_la_OBJECTS) am__EXEEXT_1 = fortranlib_test$(EXEEXT) fflush1$(EXEEXT) \ - fflush2$(EXEEXT) + fflush2$(EXEEXT) fortranlib_test_1_8$(EXEEXT) am_fflush1_OBJECTS = fflush1.$(OBJEXT) fflush1_OBJECTS = $(am_fflush1_OBJECTS) fflush1_LDADD = $(LDADD) @@ -89,8 +87,7 @@ am_fortranlib_test_OBJECTS = \ fortranlib_test-tH5Sselect.$(OBJEXT) \ fortranlib_test-tH5P.$(OBJEXT) fortranlib_test-tH5A.$(OBJEXT) \ fortranlib_test-tH5I.$(OBJEXT) fortranlib_test-tH5G.$(OBJEXT) \ - fortranlib_test-tH5E.$(OBJEXT) fortranlib_test-tf.$(OBJEXT) \ - fortranlib_test-t.$(OBJEXT) + fortranlib_test-tH5E.$(OBJEXT) fortranlib_test_OBJECTS = $(am_fortranlib_test_OBJECTS) fortranlib_test_LDADD = $(LDADD) fortranlib_test_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ @@ -98,6 +95,16 @@ fortranlib_test_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ fortranlib_test_LINK = $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ --mode=link $(FCLD) $(fortranlib_test_FCFLAGS) $(FCFLAGS) \ $(AM_LDFLAGS) $(LDFLAGS) -o $@ +am_fortranlib_test_1_8_OBJECTS = fortranlib_test_1_8.$(OBJEXT) \ + tH5F.$(OBJEXT) tH5D.$(OBJEXT) tH5R.$(OBJEXT) tH5S.$(OBJEXT) \ + tH5T.$(OBJEXT) tH5VL.$(OBJEXT) tH5Z.$(OBJEXT) \ + tH5Sselect.$(OBJEXT) tH5O.$(OBJEXT) tH5P.$(OBJEXT) \ + tH5A_1_8.$(OBJEXT) tH5I.$(OBJEXT) tH5G_1_8.$(OBJEXT) \ + tH5E.$(OBJEXT) +fortranlib_test_1_8_OBJECTS = $(am_fortranlib_test_1_8_OBJECTS) +fortranlib_test_1_8_LDADD = $(LDADD) +fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \ + $(LIBH5F) $(LIBHDF5) DEFAULT_INCLUDES = -I. -I$(top_builddir)/src@am__isrc@ depcomp = $(SHELL) $(top_srcdir)/bin/depcomp am__depfiles_maybe = depfiles @@ -118,9 +125,11 @@ FCLINK = $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link \ $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(libh5test_fortran_la_SOURCES) $(fflush1_SOURCES) \ - $(fflush2_SOURCES) $(fortranlib_test_SOURCES) + $(fflush2_SOURCES) $(fortranlib_test_SOURCES) \ + $(fortranlib_test_1_8_SOURCES) DIST_SOURCES = $(libh5test_fortran_la_SOURCES) $(fflush1_SOURCES) \ - $(fflush2_SOURCES) $(fortranlib_test_SOURCES) + $(fflush2_SOURCES) $(fortranlib_test_SOURCES) \ + $(fortranlib_test_1_8_SOURCES) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) @@ -368,11 +377,8 @@ noinst_LTLIBRARIES = libh5test_fortran.la @FORTRAN_SHARED_CONDITIONAL_FALSE@AM_LDFLAGS = -static # Our main targets, the tests themselves -TEST_PROG = fortranlib_test fflush1 fflush2 -libh5test_fortran_la_SOURCES = fortranlib_test.f90 tH5F.f90 tH5D.f90 \ - tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 tH5Sselect.f90 \ - tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 t.c - +TEST_PROG = fortranlib_test fflush1 fflush2 fortranlib_test_1_8 +libh5test_fortran_la_SOURCES = tf.f90 t.c # Source files are used for both the library and fortranlib_test. # Automake will complain about this without the following workaround. @@ -380,8 +386,11 @@ fortranlib_test_FCFLAGS = $(AM_FCFLAGS) fortranlib_test_CFLAGS = $(AM_CFLAGS) fortranlib_test_SOURCES = fortranlib_test.f90 \ tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \ - tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 \ - t.c + tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 + +fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \ + tH5F.f90 tH5D.f90 tH5R.f90 tH5S.f90 tH5T.f90 tH5VL.f90 tH5Z.f90 \ + tH5Sselect.f90 tH5O.f90 tH5P.f90 tH5A_1_8.f90 tH5I.f90 tH5G_1_8.f90 tH5E.f90 fflush1_SOURCES = fflush1.f90 fflush2_SOURCES = fflush2.f90 @@ -469,6 +478,9 @@ fflush2$(EXEEXT): $(fflush2_OBJECTS) $(fflush2_DEPENDENCIES) fortranlib_test$(EXEEXT): $(fortranlib_test_OBJECTS) $(fortranlib_test_DEPENDENCIES) @rm -f fortranlib_test$(EXEEXT) $(fortranlib_test_LINK) $(fortranlib_test_OBJECTS) $(fortranlib_test_LDADD) $(LIBS) +fortranlib_test_1_8$(EXEEXT): $(fortranlib_test_1_8_OBJECTS) $(fortranlib_test_1_8_DEPENDENCIES) + @rm -f fortranlib_test_1_8$(EXEEXT) + $(FCLINK) $(fortranlib_test_1_8_OBJECTS) $(fortranlib_test_1_8_LDADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) @@ -476,7 +488,6 @@ mostlyclean-compile: distclean-compile: -rm -f *.tab.c -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fortranlib_test-t.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t.Plo@am__quote@ .c.o: @@ -500,20 +511,6 @@ distclean-compile: @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< -fortranlib_test-t.o: t.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(fortranlib_test_CFLAGS) $(CFLAGS) -MT fortranlib_test-t.o -MD -MP -MF $(DEPDIR)/fortranlib_test-t.Tpo -c -o fortranlib_test-t.o `test -f 't.c' || echo '$(srcdir)/'`t.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/fortranlib_test-t.Tpo $(DEPDIR)/fortranlib_test-t.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='t.c' object='fortranlib_test-t.o' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(fortranlib_test_CFLAGS) $(CFLAGS) -c -o fortranlib_test-t.o `test -f 't.c' || echo '$(srcdir)/'`t.c - -fortranlib_test-t.obj: t.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(fortranlib_test_CFLAGS) $(CFLAGS) -MT fortranlib_test-t.obj -MD -MP -MF $(DEPDIR)/fortranlib_test-t.Tpo -c -o fortranlib_test-t.obj `if test -f 't.c'; then $(CYGPATH_W) 't.c'; else $(CYGPATH_W) '$(srcdir)/t.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/fortranlib_test-t.Tpo $(DEPDIR)/fortranlib_test-t.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='t.c' object='fortranlib_test-t.obj' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(fortranlib_test_CFLAGS) $(CFLAGS) -c -o fortranlib_test-t.obj `if test -f 't.c'; then $(CYGPATH_W) 't.c'; else $(CYGPATH_W) '$(srcdir)/t.c'; fi` - .f90.o: $(FCCOMPILE) -c -o $@ $< @@ -607,12 +604,6 @@ fortranlib_test-tH5E.o: tH5E.f90 fortranlib_test-tH5E.obj: tH5E.f90 $(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tH5E.obj `if test -f 'tH5E.f90'; then $(CYGPATH_W) 'tH5E.f90'; else $(CYGPATH_W) '$(srcdir)/tH5E.f90'; fi` -fortranlib_test-tf.o: tf.f90 - $(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tf.o `test -f 'tf.f90' || echo '$(srcdir)/'`tf.f90 - -fortranlib_test-tf.obj: tf.f90 - $(FC) $(fortranlib_test_FCFLAGS) $(FCFLAGS) -c -o fortranlib_test-tf.obj `if test -f 'tf.f90'; then $(CYGPATH_W) 'tf.f90'; else $(CYGPATH_W) '$(srcdir)/tf.f90'; fi` - mostlyclean-libtool: -rm -f *.lo diff --git a/fortran/test/fflush1.f90 b/fortran/test/fflush1.f90 index 44c4195..f42ae6e 100644 --- a/fortran/test/fflush1.f90 +++ b/fortran/test/fflush1.f90 @@ -58,12 +58,6 @@ ! data space identifier ! INTEGER(HID_T) :: dataspace - - ! - ! data type identifier - ! - INTEGER(HID_T) :: dtype_id - ! !The dimensions for the dataset. ! @@ -82,7 +76,7 @@ ! !data buffers ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out + INTEGER, DIMENSION(NX,NY) :: data_in INTEGER(HSIZE_T), DIMENSION(2) :: data_dims data_dims(1) = NX data_dims(2) = NY diff --git a/fortran/test/fflush2.f90 b/fortran/test/fflush2.f90 index 0414d37..38a2bd7 100644 --- a/fortran/test/fflush2.f90 +++ b/fortran/test/fflush2.f90 @@ -50,22 +50,13 @@ ! dataset identifier ! INTEGER(HID_T) :: dset_id - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace + ! ! data type identifier ! INTEGER(HID_T) :: dtype_id - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - ! !flag to check operation success ! diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90 new file mode 100644 index 0000000..970f570 --- /dev/null +++ b/fortran/test/fortranlib_test_1_8.f90 @@ -0,0 +1,966 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! +! +! Testing Fortran wrappers introduced in 1.8 release. +! +PROGRAM fortranlibtest + + USE HDF5 + + IMPLICIT NONE + INTEGER :: total_error = 0 + INTEGER :: error + INTEGER :: mounting_total_error = 0 + INTEGER :: reopen_total_error = 0 + INTEGER :: fclose_total_error = 0 + INTEGER :: fspace_total_error = 0 + INTEGER :: dataset_total_error = 0 + INTEGER :: extend_dataset_total_error = 0 + INTEGER :: refobj_total_error = 0 + INTEGER :: refreg_total_error = 0 + INTEGER :: dataspace_total_error = 0 + INTEGER :: hyperslab_total_error = 0 + INTEGER :: element_total_error = 0 + INTEGER :: basic_select_total_error = 0 + INTEGER :: total_error_compoundtest = 0 + INTEGER :: basic_datatype_total_error = 0 + INTEGER :: enum_total_error = 0 + INTEGER :: external_total_error = 0 + INTEGER :: multi_file_total_error = 0 + INTEGER :: attribute_total_error = 0 + INTEGER :: group_total_error = 0 + INTEGER :: majnum, minnum, relnum + CHARACTER(LEN=8) error_string + CHARACTER(LEN=8) :: success = ' PASSED ' + CHARACTER(LEN=8) :: failure = '*FAILED*' + CHARACTER(LEN=4) :: e_format ='(8a)' + LOGICAL :: cleanup = .TRUE. + ! LOGICAL :: cleanup = .FALSE. + + CALL h5open_f(error) + WRITE(*,*) ' ========================== ' + WRITE(*,*) ' FORTRAN 1.8 tests ' + WRITE(*,*) ' ========================== ' + CALL h5get_libversion_f(majnum, minnum, relnum, total_error) + IF(total_error .EQ. 0) THEN + WRITE(*, '(" FORTRANLIB_TEST is linked with HDF5 Library version ")', advance="NO") + WRITE(*, '(I1)', advance="NO") majnum + WRITE(*, '(".")', advance="NO") + WRITE(*, '(I1)', advance="NO") minnum + WRITE(*, '(" release ")', advance="NO") + WRITE(*, '(I3)') relnum + ELSE + total_error = total_error + 1 + ENDIF + WRITE(*,*) + + error_string = failure + CALL file_space(cleanup, fspace_total_error) + IF (fspace_total_error == 0) error_string = success + WRITE(*, fmt = '(21a)', advance = 'no') ' File free space test' + WRITE(*, fmt = '(49x,a)', advance = 'no') ' ' + WRITE(*, fmt = e_format) error_string + total_error = total_error + fspace_total_error + + ! write(*,*) + ! write(*,*) '=========================================' + ! write(*,*) 'Testing ATTRIBUTE interface ' + ! write(*,*) '=========================================' + + error_string = failure + CALL attribute_test_1_8(cleanup, attribute_total_error) + WRITE(*, fmt = '(15a)', advance = 'no') ' ATTRIBUTE TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (attribute_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + attribute_total_error + + CALL group_test(cleanup, group_total_error) + WRITE(*, fmt = '(15a)', advance = 'no') ' GROUP TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (group_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + group_total_error + + CALL test_h5o(cleanup, group_total_error ) + WRITE(*, fmt = '(15a)', advance = 'no') ' H5O TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (group_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + group_total_error + + CALL dtransform(cleanup, group_total_error) + WRITE(*, fmt = '(15a)', advance = 'no') ' Dtransform TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (group_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + group_total_error + + CALL test_genprop_basic_class(cleanup, group_total_error) + WRITE(*, fmt = '(30a)', advance = 'no') ' test_genprop_basic_class TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (group_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + group_total_error + CALL test_h5s_encode(cleanup, group_total_error) + WRITE(*, fmt = '(15a)', advance = 'no') ' test_h5s_encode TEST' + WRITE(*, fmt = '(55x,a)', advance = 'no') ' ' + IF (group_total_error == 0) error_string = success + WRITE(*, fmt = e_format) error_string + total_error = total_error + group_total_error + +! CALL test_hard_query(group_total_error) + + total_error = total_error + group_total_error + + WRITE(*,*) + + WRITE(*,*) ' ============================================ ' + WRITE(*, fmt = '(19x, 27a)', advance='NO') ' FORTRAN tests completed with ' + WRITE(*, fmt = '(i4)', advance='NO') total_error + WRITE(*, fmt = '(12a)' ) ' error(s) ! ' + WRITE(*,*) ' ============================================ ' + + CALL h5close_f(error) + + ! if errors detected, exit with non-zero code. + IF (total_error .NE. 0) CALL h5_exit_f (1) + +END PROGRAM fortranlibtest + +SUBROUTINE dtransform(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: dxpl_id_c_to_f, dxpl_id_c_to_f_copy + INTEGER(HID_T) :: dxpl_id_simple, dxpl_id_polynomial, dxpl_id_polynomial_copy, dxpl_id_utrans_inv, file_id + + CHARACTER(LEN=15), PARAMETER :: c_to_f = "(9/5.0)*x + 123" + INTEGER :: error + CHARACTER(LEN=15) :: ptrgetTest + CHARACTER(LEN=7) :: ptrgetTest_small + CHARACTER(LEN=30) :: ptrgetTest_big + + INTEGER(SIZE_T) :: size + + + CALL H5Fcreate_f("dtransform.h5", H5F_ACC_TRUNC_F, file_id, error) + CALL check("dtransform.H5Fcreate_f", error, total_error) + + CALL H5Pcreate_f(H5P_DATASET_XFER_F, dxpl_id_c_to_f, error) + CALL check("dtransform.H5Pcreate_f", error, total_error) + + CALL H5Pset_data_transform_f(dxpl_id_c_to_f, c_to_f, error) + CALL check("dtransform.H5Pset_data_transform_f", error, total_error) + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f, ptrgetTest, total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error) + +! check case when receiving buffer to small + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_small, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:7), ptrgetTest_small, total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size),15, total_error) + +! check case when receiving buffer to big + + CALL H5Pget_data_transform_f(dxpl_id_c_to_f, ptrgetTest_big, error, size=size) + CALL check("dtransform.H5Pget_data_transform_f", error, total_error) + CALL VerifyString("dtransform.H5Pget_data_transform_f", c_to_f(1:15), ptrgetTest_big(1:15), total_error) + CALL VERIFY("dtransform.H5Pget_data_transform_f", INT(size), 15, total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("dtransform", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + +END SUBROUTINE dtransform + + +!/**************************************************************** +!** +!** test_genprop_basic_class(): Test basic generic property list code. +!** Tests creating new generic classes. +!** +!****************************************************************/ + +SUBROUTINE test_genprop_basic_class(cleanup, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: cid1 !/* Generic Property class ID */ + INTEGER(HID_T) :: cid2 !/* Generic Property class ID */ + INTEGER(HID_T) :: cid3 !/* Generic Property class ID */ + + CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" + CHARACTER(LEN=7) :: name ! /* Name of class */ + CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */ + CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/ + INTEGER :: error + INTEGER :: size + LOGICAL :: flag + + !/* Output message about test being performed */ + + WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality" + + ! /* Create a new generic class, derived from the root of the class hierarchy */ + CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error) + CALL check("H5Pcreate_class", error, total_error) + + ! /* Check class name */ + CALL H5Pget_class_name_f(cid1, name, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", name, CLASS1_NAME, error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',name, 'CLASS1_NAME=',CLASS1_NAME + total_error = total_error + 1 + ENDIF + + ! /* Check class name smaller buffer*/ + CALL H5Pget_class_name_f(cid1, name_small, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", name_small(1:4), CLASS1_NAME(1:4), error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',name_small(1:4), 'CLASS1_NAME=',CLASS1_NAME(1:4) + total_error = total_error + 1 + ENDIF + + ! /* Check class name bigger buffer*/ + CALL H5Pget_class_name_f(cid1, name_big, size, error) + CALL check("H5Pget_class_name", error, total_error) + CALL VERIFY("H5Pget_class_name", size,7,error) + CALL verifystring("H5Pget_class_name", TRIM(name_big), TRIM(CLASS1_NAME), error) + IF(error.NE.0)THEN + WRITE(*,*) 'Class names do not match! name=',TRIM(name_small), 'CLASS1_NAME=',TRIM(CLASS1_NAME) + total_error = total_error + 1 + ENDIF + + ! /* Check class parent */ + CALL H5Pget_class_parent_f(cid1, cid2, error) + CALL check("H5Pget_class_parent_f", error, total_error) + + ! /* Verify class parent correct */ + CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error) + CALL check("H5Pequal_f", error, total_error) + CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error) + + + ! /* Make certain false postives aren't being returned */ + CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error) + CALL check("H5Pequal_f", error, total_error) + CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error) + + !/* Close parent class */ + CALL H5Pclose_class_f(cid2, error) + CALL check("H5Pclose_class_f", error, total_error) + + + !/* Close class */ + CALL H5Pclose_class_f(cid1, error) + CALL check("H5Pclose_class_f", error, total_error) + +END SUBROUTINE test_genprop_basic_class + +SUBROUTINE test_h5s_encode(cleanup, total_error) + +!/**************************************************************** +!** +!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding. +!** +!****************************************************************/ + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid1, sid2, sid3! /* Dataspace ID */ + INTEGER(hid_t) :: decoded_sid1, decoded_sid2, decoded_sid3 + INTEGER :: rank !/* LOGICAL rank of dataspace */ + INTEGER(size_t) :: sbuf_size=0, null_size=0, scalar_size=0 + +! Make sure the size is large, need variable length in fortran 2003 + CHARACTER(LEN=288) :: sbuf + CHARACTER(LEN=288) :: scalar_buf +! F2003 CHARACTER(LEN=:), ALLOCATABLE :: sbuf + +! unsigned char *sbuf=NULL, *null_sbuf=NULL, *scalar_buf=NULL; +! hsize_t tdims[4]; /* Dimension array to test with */ + INTEGER(hsize_t) :: n ! /* Number of dataspace elements */ + + INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/) + INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/) + INTEGER(hsize_t), DIMENSION(1:3) :: count = (/2, 2, 2/) + INTEGER(hsize_t), DIMENSION(1:3) :: BLOCK = (/1, 3, 1/) + + INTEGER :: space_type + +! H5S_sel_type sel_type; +! hssize_t nblocks; + ! + !Dataset dimensions + ! + INTEGER, PARAMETER :: SPACE1_DIM1= 3, SPACE1_DIM2=15, SPACE1_DIM3=13 + + INTEGER(HSIZE_T), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/) + INTEGER :: SPACE1_RANK = 3 + INTEGER :: error + + !/* Output message about test being performed */ + WRITE(*,*) "Testing Dataspace Encoding and Decoding" + + !/*------------------------------------------------------------------------- + ! * Test encoding and decoding of simple dataspace and hyperslab selection. + ! *------------------------------------------------------------------------- + ! */ + + CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error) + CALL check("H5Screate_simple", error, total_error) + + CALL h5sselect_hyperslab_f(sid1, H5S_SELECT_SET_F, & + start, count, error, stride=stride, BLOCK=BLOCK) + CALL check("h5sselect_hyperslab_f", error, total_error) + + + !/* Encode simple data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + ! In fortran 2003 we can allocate the needed character size here + + ! /* Try decoding bogus buffer */ + + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL VERIFY("H5Sdecode", error, -1, total_error) + + CALL H5Sencode_f(sid1, sbuf, sbuf_size, error) + CALL check("H5Sencode", error, total_error) + + ! /* Decode from the dataspace buffer and return an object handle */ + CALL H5Sdecode_f(sbuf, decoded_sid1, error) + CALL check("H5Sdecode", error, total_error) + + + ! /* Verify the decoded dataspace */ + CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error) + CALL check("h5sget_simple_extent_npoints_f", error, total_error) + CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3, & + total_error) + +!!$ +!!$ rank = H5Sget_simple_extent_ndims(decoded_sid1); +!!$ CHECK(rank, FAIL, "H5Sget_simple_extent_ndims"); +!!$ VERIFY(rank, SPACE1_RANK, "H5Sget_simple_extent_ndims"); +!!$ +!!$ rank = H5Sget_simple_extent_dims(decoded_sid1, tdims, NULL); +!!$ CHECK(rank, FAIL, "H5Sget_simple_extent_dims"); +!!$ VERIFY(HDmemcmp(tdims, dims1, SPACE1_RANK * sizeof(hsize_t)), 0, +!!$ "H5Sget_simple_extent_dims"); +!!$ +!!$ /* Verify hyperslabe selection */ +!!$ sel_type = H5Sget_select_type(decoded_sid1); +!!$ VERIFY(sel_type, H5S_SEL_HYPERSLABS, "H5Sget_select_type"); +!!$ +!!$ nblocks = H5Sget_select_hyper_nblocks(decoded_sid1); +!!$ VERIFY(nblocks, 2*2*2, "H5Sget_select_hyper_nblocks"); +!!$ + ! + !Close the dataspace for the dataset. + ! + CALL h5sclose_f(sid1, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid1, error) + CALL check("h5sclose_f", error, total_error) + +!!$ +!!$ ret = H5Sclose(decoded_sid1); +!!$ CHECK(ret, FAIL, "H5Sclose"); +!!$ +!!$ /*------------------------------------------------------------------------- +!!$ * Test encoding and decoding of null dataspace. +!!$ *------------------------------------------------------------------------- +!!$ */ +!!$ sid2 = H5Screate(H5S_NULL); +!!$ CHECK(sid2, FAIL, "H5Screate"); +!!$ +!!$ /* Encode null data space in a buffer */ +!!$ ret = H5Sencode(sid2, NULL, &null_size); +!!$ CHECK(ret, FAIL, "H5Sencode"); +!!$ +!!$ if(null_size>0) +!!$ null_sbuf = (unsigned char*)HDcalloc((size_t)1, null_size); +!!$ +!!$ ret = H5Sencode(sid2, null_sbuf, &null_size); +!!$ CHECK(ret, FAIL, "H5Sencode"); +!!$ +!!$ /* Decode from the dataspace buffer and return an object handle */ +!!$ decoded_sid2=H5Sdecode(null_sbuf); +!!$ CHECK(decoded_sid2, FAIL, "H5Sdecode"); +!!$ +!!$ /* Verify decoded dataspace */ +!!$ space_type = H5Sget_simple_extent_type(decoded_sid2); +!!$ VERIFY(space_type, H5S_NULL, "H5Sget_simple_extent_type"); +!!$ +!!$ ret = H5Sclose(sid2); +!!$ CHECK(ret, FAIL, "H5Sclose"); +!!$ +!!$ ret = H5Sclose(decoded_sid2); +!!$ CHECK(ret, FAIL, "H5Sclose"); +!!$ + ! /*------------------------------------------------------------------------- + ! * Test encoding and decoding of scalar dataspace. + ! *------------------------------------------------------------------------- + ! */ + ! /* Create scalar dataspace */ + + CALL H5Screate_f(H5S_SCALAR_F, sid3, error) + CALL check("H5Screate_f",error, total_error) + + ! /* Encode scalar data space in a buffer */ + + ! First find the buffer size + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + ! encode + + CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error) + CALL check("H5Sencode_f", error, total_error) + + + ! /* Decode from the dataspace buffer and return an object handle */ + + CALL H5Sdecode_f(scalar_buf, decoded_sid3, error) + CALL check("H5Sdecode_f", error, total_error) + + + ! /* Verify extent type */ + + CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error) + CALL check("H5Sget_simple_extent_type_f", error, total_error) + CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error) + + ! /* Verify decoded dataspace */ + CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error) + CALL check("h5sget_simple_extent_npoints_f", error, total_error) + CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error) + + CALL H5Sget_simple_extent_ndims_f(decoded_sid3, rank, error) + CALL CHECK("H5Sget_simple_extent_ndims_f", error, total_error) + CALL VERIFY("H5Sget_simple_extent_ndims_f", rank, 0, total_error ) + + CALL h5sclose_f(sid3, error) + CALL check("h5sclose_f", error, total_error) + + CALL h5sclose_f(decoded_sid3, error) + CALL check("h5sclose_f", error, total_error) + +END SUBROUTINE test_h5s_encode + +!/*------------------------------------------------------------------------- +! * Function: test_hard_query +! * +! * Purpose: Tests H5Tcompiler_conv() for querying whether a conversion is +! * a hard one. +! * +! * Return: Success: 0 +! * +! * Failure: number of errors +! * +! * Programmer: Raymond Lu +! * Friday, Sept 2, 2005 +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + +!!$SUBROUTINE test_hard_query(total_error) +!!$ +!!$ USE HDF5 ! This module contains all necessary modules +!!$ +!!$ IMPLICIT NONE +!!$ INTEGER, INTENT(INOUT) :: total_error +!!$ +!!$ INTEGER :: error +!!$ LOGICAL :: flag +!!$ +!!$ WRITE(*,*) "query functions of compiler conversion" +!!$ +!!$ ! /* Verify the conversion from int to float is a hard conversion. */ +!!$ +!!$ CALL H5Tcompiler_conv_f(H5T_INTEGER_F, H5T_FLOAT_F, flag, error) +!!$ CALL check("H5Tcompiler_conv", error, total_error) +!!$ CALL VerifyLogical("H5Tcompiler_conv", flag, .TRUE.,total_error) + +!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) { +!!$ H5_FAILED(); +!!$ printf("Can't query conversion function\n"); +!!$ goto error; +!!$ } + +!!$ /* Unregister the hard conversion from int to float. Verify the conversion +!!$ * is a soft conversion. */ +!!$ H5Tunregister(H5T_PERS_HARD, NULL, H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float); +!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=FALSE) { +!!$ H5_FAILED(); +!!$ printf("Can't query conversion function\n"); +!!$ goto error; +!!$ } +!!$ +!!$ /* Register the hard conversion from int to float. Verify the conversion +!!$ * is a hard conversion. */ +!!$ H5Tregister(H5T_PERS_HARD, "int_flt", H5T_NATIVE_INT, H5T_NATIVE_FLOAT, H5T_conv_int_float); +!!$ if((ret = H5Tcompiler_conv(H5T_NATIVE_INT, H5T_NATIVE_FLOAT))!=TRUE) { +!!$ H5_FAILED(); +!!$ printf("Can't query conversion function\n"); +!!$ goto error; +!!$ } +!!$ +!!$ PASSED(); +!!$ reset_hdf5(); +!!$ +!!$ return 0; +!!$ +!!$END SUBROUTINE test_hard_query + + +!/*------------------------------------------------------------------------- +! * Function: test_encode +! * +! * Purpose: Tests functions of encoding and decoding datatype. +! * +! * Return: Success: 0 +! * +! * Failure: number of errors +! * +! * Programmer: Raymond Lu +! * July 14, 2004 +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + +!!$SUBROUTINE test_encode(total_error) +!!$ +!!$ USE HDF5 ! This module contains all necessary modules +!!$ struct s1 { +!!$ int a; +!!$ float b; +!!$ long c; +!!$ double d; +!!$ }; +!!$ IMPLICIT NONE +!!$ INTEGER, INTENT(INOUT) :: total_error +!!$ INTEGER(SIZE_T), PARAMETER :: sizechar = 1024 +!!$ INTEGER :: error +!!$ INTEGER(hid_t) :: file=-1, tid1=-1, tid2=-1 +!!$ INTEGER(hid_t) :: decoded_tid1=-1, decoded_tid2=-1 +!!$ CHARACTER(LEN=1024) :: filename = 'encode.h5' +!!$ char compnd_type[]="Compound_type", enum_type[]="Enum_type"; +!!$ short enum_val; +!!$ size_t cmpd_buf_size = 0; +!!$ size_t enum_buf_size = 0; +!!$ unsigned char *cmpd_buf=NULL, *enum_buf=NULL; +!!$ herr_t ret; +!!$ INTEGER(HID_T) :: dt5_id ! Memory datatype identifier +!!$ +!!$ INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype +!!$ +!!$ WRITE(*,*) "functions of encoding and decoding datatypes" +!!$ +!!$ !/* Create File */ +!!$ +!!$ CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file, error) +!!$ CALL check("H5Fcreate_f", error, total_error) +!!$ +!!$ !/*----------------------------------------------------------------------- +!!$ ! * Create compound and enumerate datatypes +!!$ ! *----------------------------------------------------------------------- +!!$ ! */ +!!$ +!!$ ! /* Create a compound datatype */ +!!$ CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error) +!!$ CALL check("h5tcopy_f", error, total_error) +!!$ sizechar = 2 +!!$ CALL h5tset_size_f(dt5_id, sizechar, error) +!!$ CALL check("h5tset_size_f", error, total_error) +!!$ CALL h5tget_size_f(dt5_id, type_sizec, error) +!!$ CALL check("h5tget_size_f", error, total_error) +!!$ +!!$ CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizec, error) +!!$ CALL check("h5tget_size_f", error, total_error) +!!$ CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dtype_id, error) +!!$ +!!$ +!!$ if((tid1=H5Tcreate(H5T_COMPOUND, sizeof(struct s1))) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't create datatype!\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tinsert(tid1, "a", HOFFSET(struct s1, a), H5T_NATIVE_INT) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field 'a'\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tinsert(tid1, "b", HOFFSET(struct s1, b), H5T_NATIVE_FLOAT) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field 'b'\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tinsert(tid1, "c", HOFFSET(struct s1, c), H5T_NATIVE_LONG) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field 'c'\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tinsert(tid1, "d", HOFFSET(struct s1, d), H5T_NATIVE_DOUBLE) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field 'd'\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Create a enumerate datatype */ +!!$ if((tid2=H5Tcreate(H5T_ENUM, sizeof(short))) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't create enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tenum_insert(tid2, "RED", (enum_val=0,&enum_val)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field into enumeration type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tenum_insert(tid2, "GREEN", (enum_val=1,&enum_val)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field into enumeration type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tenum_insert(tid2, "BLUE", (enum_val=2,&enum_val)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field into enumeration type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tenum_insert(tid2, "ORANGE", (enum_val=3,&enum_val)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field into enumeration type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tenum_insert(tid2, "YELLOW", (enum_val=4,&enum_val)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't insert field into enumeration type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /*----------------------------------------------------------------------- +!!$ * Test encoding and decoding compound and enumerate datatypes +!!$ *----------------------------------------------------------------------- +!!$ */ +!!$ /* Encode compound type in a buffer */ +!!$ if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode compound type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(cmpd_buf_size>0) +!!$ cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size); +!!$ +!!$ /* Try decoding bogus buffer */ +!!$ H5E_BEGIN_TRY { +!!$ ret = H5Tdecode(cmpd_buf); +!!$ } H5E_END_TRY; +!!$ if(ret!=FAIL) { +!!$ H5_FAILED(); +!!$ printf("Decoded bogus buffer!\n"); +!!$ goto error; +!!$ } +!!$ +!!$ if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode compound type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Decode from the compound buffer and return an object handle */ +!!$ if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0) +!!$ FAIL_PUTS_ERROR("Can't decode compound type\n") +!!$ +!!$ /* Verify that the datatype was copied exactly */ +!!$ if(H5Tequal(decoded_tid1, tid1)<=0) { +!!$ H5_FAILED(); +!!$ printf("Datatype wasn't encoded & decoded identically\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Query member number and member index by name, for compound type. */ +!!$ if(H5Tget_nmembers(decoded_tid1)!=4) { +!!$ H5_FAILED(); +!!$ printf("Can't get member number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tget_member_index(decoded_tid1, "c")!=2) { +!!$ H5_FAILED(); +!!$ printf("Can't get correct index number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ +!!$ /* Encode enumerate type in a buffer */ +!!$ if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(enum_buf_size>0) +!!$ enum_buf = (unsigned char*)calloc(1, enum_buf_size); +!!$ +!!$ if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Decode from the enumerate buffer and return an object handle */ +!!$ if((decoded_tid2=H5Tdecode(enum_buf)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't decode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Verify that the datatype was copied exactly */ +!!$ if(H5Tequal(decoded_tid2, tid2)<=0) { +!!$ H5_FAILED(); +!!$ printf("Datatype wasn't encoded & decoded identically\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Query member number and member index by name, for enumeration type. */ +!!$ if(H5Tget_nmembers(decoded_tid2)!=5) { +!!$ H5_FAILED(); +!!$ printf("Can't get member number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tget_member_index(decoded_tid2, "ORANGE") != 3) { +!!$ H5_FAILED(); +!!$ printf("Can't get correct index number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /*----------------------------------------------------------------------- +!!$ * Commit and reopen the compound and enumerate datatypes +!!$ *----------------------------------------------------------------------- +!!$ */ +!!$ /* Commit compound datatype and close it */ +!!$ if(H5Tcommit2(file, compnd_type, tid1, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't commit compound datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(tid1) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(decoded_tid1) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ free(cmpd_buf); +!!$ cmpd_buf_size = 0; +!!$ +!!$ /* Commit enumeration datatype and close it */ +!!$ if(H5Tcommit2(file, enum_type, tid2, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't commit compound datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(tid2) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(decoded_tid2) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ free(enum_buf); +!!$ enum_buf_size = 0; +!!$ +!!$ /* Open the dataytpe for query */ +!!$ if((tid1 = H5Topen2(file, compnd_type, H5P_DEFAULT)) < 0) +!!$ FAIL_STACK_ERROR +!!$ if((tid2 = H5Topen2(file, enum_type, H5P_DEFAULT)) < 0) +!!$ FAIL_STACK_ERROR +!!$ +!!$ +!!$ /* Encode compound type in a buffer */ +!!$ if(H5Tencode(tid1, NULL, &cmpd_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode compound type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(cmpd_buf_size>0) +!!$ cmpd_buf = (unsigned char*)calloc(1, cmpd_buf_size); +!!$ +!!$ if(H5Tencode(tid1, cmpd_buf, &cmpd_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode compound type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Decode from the compound buffer and return an object handle */ +!!$ if((decoded_tid1 = H5Tdecode(cmpd_buf)) < 0) +!!$ FAIL_PUTS_ERROR("Can't decode compound type\n") +!!$ +!!$ /* Verify that the datatype was copied exactly */ +!!$ if(H5Tequal(decoded_tid1, tid1)<=0) { +!!$ H5_FAILED(); +!!$ printf("Datatype wasn't encoded & decoded identically\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Query member number and member index by name, for compound type. */ +!!$ if(H5Tget_nmembers(decoded_tid1)!=4) { +!!$ H5_FAILED(); +!!$ printf("Can't get member number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tget_member_index(decoded_tid1, "c")!=2) { +!!$ H5_FAILED(); +!!$ printf("Can't get correct index number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /*----------------------------------------------------------------------- +!!$ * Test encoding and decoding compound and enumerate datatypes +!!$ *----------------------------------------------------------------------- +!!$ */ +!!$ /* Encode enumerate type in a buffer */ +!!$ if(H5Tencode(tid2, NULL, &enum_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(enum_buf_size>0) +!!$ enum_buf = (unsigned char*)calloc(1, enum_buf_size); +!!$ +!!$ if(H5Tencode(tid2, enum_buf, &enum_buf_size) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't encode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Decode from the enumerate buffer and return an object handle */ +!!$ if((decoded_tid2=H5Tdecode(enum_buf)) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't decode enumerate type\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Verify that the datatype was copied exactly */ +!!$ if(H5Tequal(decoded_tid2, tid2)<=0) { +!!$ H5_FAILED(); +!!$ printf("Datatype wasn't encoded & decoded identically\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Query member number and member index by name, for enumeration type. */ +!!$ if(H5Tget_nmembers(decoded_tid2)!=5) { +!!$ H5_FAILED(); +!!$ printf("Can't get member number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tget_member_index(decoded_tid2, "ORANGE")!=3) { +!!$ H5_FAILED(); +!!$ printf("Can't get correct index number\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /*----------------------------------------------------------------------- +!!$ * Close and release +!!$ *----------------------------------------------------------------------- +!!$ */ +!!$ /* Close datatype and file */ +!!$ if(H5Tclose(tid1) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(tid2) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(H5Tclose(decoded_tid1) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ if(H5Tclose(decoded_tid2) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close datatype\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ if(H5Fclose(file) < 0) { +!!$ H5_FAILED(); +!!$ printf("Can't close file\n"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ free(cmpd_buf); +!!$ free(enum_buf); +!!$ +!!$ PASSED(); +!!$ return 0; +!!$ +!!$ error: +!!$ H5E_BEGIN_TRY { +!!$ H5Tclose (tid1); +!!$ H5Tclose (tid2); +!!$ H5Tclose (decoded_tid1); +!!$ H5Tclose (decoded_tid2); +!!$ H5Fclose (file); +!!$ } H5E_END_TRY; +!!$ return 1; +!!$} diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90 index 44c7964..b73dd8a 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -56,10 +56,7 @@ INTEGER(HID_T) :: attr5_id !Integer Attribute identifier INTEGER(HID_T) :: attr6_id !Null Attribute identifier INTEGER(HID_T) :: aspace_id !String Attribute Dataspace identifier - INTEGER(HID_T) :: aspace2_id !Character Attribute Dataspace identifier - INTEGER(HID_T) :: aspace3_id !Double Attribute Dataspace identifier - INTEGER(HID_T) :: aspace4_id !Real Attribute Dataspace identifier - INTEGER(HID_T) :: aspace5_id !Integer Attribute Dataspace identifier + INTEGER(HID_T) :: aspace2_id !Character Attribute Dataspace identifier INTEGER(HID_T) :: aspace6_id !Null Attribute Dataspace identifier INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier INTEGER(HID_T) :: atype2_id !Character Attribute Datatype identifier @@ -79,7 +76,8 @@ INTEGER(HID_T) :: attr4_type !Returned REAL Attribute Datatype identifier INTEGER(HID_T) :: attr5_type !Returned INTEGER Attribute Datatype identifier INTEGER(HID_T) :: attr6_type !Returned NULL Attribute Datatype identifier - INTEGER :: num_attrs !number of attributes + INTEGER :: num_attrs !number of attributes + INTEGER(HSIZE_T) :: attr_storage ! attributes storage requirements .MSB. CHARACTER(LEN=256) :: attr_name !buffer to put attr_name INTEGER(SIZE_T) :: name_size = 80 !attribute name length @@ -113,32 +111,32 @@ ! !data buffers ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out + INTEGER, DIMENSION(NX,NY) :: data_in ! !Initialize data_in buffer ! - do i = 1, NX - do j = 1, NY + DO i = 1, NX + DO j = 1, NY data_in(i,j) = (i-1) + (j-1) - end do - end do + END DO + END DO ! ! Initialize attribute's data ! attr_data(1) = 'Dataset character attribute' attr_data(2) = 'Some other string here ' - attrlen = len(attr_data(1)) + attrlen = LEN(attr_data(1)) ! ! Create the file. ! CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify file name" + STOP + ENDIF CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) CALL check("h5fcreate_f",error,total_error) @@ -247,8 +245,10 @@ ! ! Create dataset NULL attribute of INTEGER. ! + CALL h5acreate_f(dset_id, aname6, atype5_id, aspace6_id, & attr6_id, error) + CALL check("h5acreate_f",error,total_error) ! @@ -287,6 +287,29 @@ ! CALL h5awrite_f(attr6_id, atype5_id, attr_integer_data, data_dims, error) CALL check("h5awrite_f",error,total_error) + + ! + ! check the amount of storage that is required for the specified attribute .MSB. + ! + CALL h5aget_storage_size_f(attr_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL VERIFY("h5aget_storage_size_f",attr_storage,*SizeOf(attr_storage),total_error) + CALL h5aget_storage_size_f(attr2_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,1,total_error) + CALL h5aget_storage_size_f(attr3_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,8,total_error) + CALL h5aget_storage_size_f(attr4_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,4,total_error) + CALL h5aget_storage_size_f(attr5_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,4,total_error) + CALL h5aget_storage_size_f(attr6_id, attr_storage, error) + CALL check("h5aget_storage_size_f",error,total_error) +! CALL verify("h5aget_storage_size_f",attr_storage,0,total_error) + ! ! Close the attribute. @@ -383,12 +406,12 @@ ! CALL h5aget_name_f(attr5_id, name_size, attr_name, error) CALL check("h5aget_name_f",error,total_error) - if (attr_name(1:12) .ne. aname5) then + IF (attr_name(1:12) .NE. aname5) THEN total_error = total_error + 1 - end if - if (error .ne. 12) then + END IF + IF (error .NE. 12) THEN total_error = total_error + 1 - end if + END IF ! !get the STRING attrbute space @@ -438,10 +461,10 @@ ! CALL h5aget_num_attrs_f(dset_id, num_attrs, error) CALL check("h5aget_num_attrs_f",error,total_error) - if (num_attrs .ne. 6) then - write(*,*) "got number of attributes wrong", num_attrs + IF (num_attrs .NE. 6) THEN + WRITE(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 - end if + END IF ! !set the read back data type's size @@ -458,60 +481,60 @@ CALL h5aread_f(attr_id, atype_id, aread_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if ( (aread_data(1) .ne. attr_data(1)) .or. (aread_data(2) .ne. attr_data(2)) ) then - write(*,*) "Read back string attrbute is wrong", aread_data(1), aread_data(2) + IF ( (aread_data(1) .NE. attr_data(1)) .OR. (aread_data(2) .NE. attr_data(2)) ) THEN + WRITE(*,*) "Read back string attrbute is wrong", aread_data(1), aread_data(2) total_error = total_error + 1 - end if + END IF ! !read the CHARACTER attribute data back to memory ! CALL h5aread_f(attr2_id, H5T_NATIVE_CHARACTER, aread_character_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if (aread_character_data .ne. 'A' ) then - write(*,*) "Read back character attrbute is wrong ",aread_character_data + IF (aread_character_data .NE. 'A' ) THEN + WRITE(*,*) "Read back character attrbute is wrong ",aread_character_data total_error = total_error + 1 - end if + END IF ! !read the double attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if (aread_double_data(1) .ne. 3.459 ) then - write(*,*) "Read back double attrbute is wrong", aread_double_data(1) + IF (aread_double_data(1) .NE. 3.459 ) THEN + WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1) total_error = total_error + 1 - end if + END IF ! !read the real attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if (aread_real_data(1) .ne. 4.0 ) then - write(*,*) "Read back real attrbute is wrong ", aread_real_data + IF (aread_real_data(1) .NE. 4.0 ) THEN + WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data total_error = total_error + 1 - end if + END IF ! !read the Integer attribute data back to memory ! data_dims(1) = 1 CALL h5aread_f(attr5_id, H5T_NATIVE_INTEGER, aread_integer_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if (aread_integer_data(1) .ne. 5 ) then - write(*,*) "Read back integer attrbute is wrong ", aread_integer_data + IF (aread_integer_data(1) .NE. 5 ) THEN + WRITE(*,*) "Read back integer attrbute is wrong ", aread_integer_data total_error = total_error + 1 - end if + END IF ! !read the null attribute data. nothing can be read. ! data_dims(1) = 1 CALL h5aread_f(attr6_id, H5T_NATIVE_INTEGER, aread_null_data, data_dims, error) CALL check("h5aread_f",error,total_error) - if (aread_null_data(1) .ne. 7 ) then - write(*,*) "Read back null attrbute is wrong ", aread_null_data + IF (aread_null_data(1) .NE. 7 ) THEN + WRITE(*,*) "Read back null attrbute is wrong ", aread_null_data total_error = total_error + 1 - end if + END IF ! ! Close the attribute. @@ -540,10 +563,10 @@ ! CALL h5aget_num_attrs_f(dset_id, num_attrs, error) CALL check("h5aget_num_attrs_f",error,total_error) - if (num_attrs .ne. 5) then - write(*,*) "got number of attributes wrong", num_attrs + IF (num_attrs .NE. 5) THEN + WRITE(*,*) "got number of attributes wrong", num_attrs total_error = total_error +1 - end if + END IF @@ -582,7 +605,7 @@ ! ! Remove the file ! - if (cleanup) call h5_cleanup_f(filename, H5P_DEFAULT_F, error) + IF (cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) RETURN END SUBROUTINE attribute_test diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90 new file mode 100644 index 0000000..8a5f99a --- /dev/null +++ b/fortran/test/tH5A_1_8.f90 @@ -0,0 +1,3778 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +SUBROUTINE attribute_test_1_8(cleanup, total_error) + +! This subroutine tests following 1.8 functionalities: +! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f, +! h5aget_name_f,h5aget_space_f, h5aget_type_f, H5Pset_shared_mesg_nindexes_f, +! H5Pset_shared_mesg_index_f +! + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name + CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name + CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name + CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name + CHARACTER(LEN=11), PARAMETER :: aname3 = "attr_double" !DOuble Attribute name + CHARACTER(LEN=9), PARAMETER :: aname4 = "attr_real" !Real Attribute name + CHARACTER(LEN=12), PARAMETER :: aname5 = "attr_integer" !Integer Attribute name + CHARACTER(LEN=9), PARAMETER :: aname6 = "attr_null" !Null Attribute name + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 + + ! + !general purpose integer + ! + INTEGER :: i, j + INTEGER :: error ! Error flag + + ! NEW STARTS HERE + INTEGER(HID_T) :: fapl = -1, fapl2 = -1 + INTEGER(HID_T) :: fcpl = -1, fcpl2 = -1 + INTEGER(HID_T) :: my_fapl, my_fcpl + LOGICAL, DIMENSION(1:2) :: new_format = (/.TRUE.,.FALSE./) + LOGICAL, DIMENSION(1:2) :: use_shared = (/.TRUE.,.FALSE./) + + +! ******************** +! test_attr equivelent +! ******************** + + WRITE(*,*) "TESTING ATTRIBUTES" + + CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl,error) + CALL check("h5Pcreate_f",error,total_error) + CALL h5pcopy_f(fapl, fapl2, error) + CALL check("h5pcopy_f",error,total_error) + + CALL H5Pcreate_f(H5P_FILE_CREATE_F,fcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + CALL h5pcopy_f(fcpl, fcpl2, error) + CALL check("h5pcopy_f",error,total_error) + + CALL H5Pset_shared_mesg_nindexes_f(fcpl2,1,error) + CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error) + + CALL H5Pset_shared_mesg_index_f(fcpl2, 0, H5O_SHMESG_ATTR_FLAG_F, 1, error) + CALL check(" H5Pset_shared_mesg_index_f",error, total_error) + + DO i = 1, 2 + IF (new_format(i)) THEN + WRITE(*,*) " - Testing with new file format" + my_fapl = fapl2 + ELSE + WRITE(*,*) " - Testing with old file format" + my_fapl = fapl + END IF + CALL test_attr_basic_write(my_fapl, total_error) +!!$ CALL test_attr_basic_read(my_fapl) +!!$ CALL test_attr_flush(my_fapl) +!!$ CALL test_attr_plist(my_fapl) ! this is next +!!$ CALL test_attr_compound_write(my_fapl) +!!$ CALL test_attr_compound_read(my_fapl) +!!$ CALL test_attr_scalar_write(my_fapl) +!!$ CALL test_attr_scalar_read(my_fapl) +!!$ CALL test_attr_mult_write(my_fapl) +!!$ CALL test_attr_mult_read(my_fapl) +!!$ CALL test_attr_iterate(my_fapl) +!!$ CALL test_attr_delete(my_fapl) +!!$ CALL test_attr_dtype_shared(my_fapl) + IF(new_format(i)) THEN + DO j = 1, 2 + IF (use_shared(j)) THEN + WRITE(*,*) " - Testing with shared attributes" + my_fcpl = fcpl2 + ELSE + WRITE(*,*) " - Testing without shared attributes" + my_fcpl = fcpl + END IF +!!$ CALL test_attr_dense_create(my_fcpl, my_fapl) + CALL test_attr_dense_open(my_fcpl, my_fapl, total_error) +!!$ CALL test_attr_dense_delete(my_fcpl, my_fapl) +!!$ CALL test_attr_dense_rename(my_fcpl, my_fapl) +!!$ CALL test_attr_dense_unlink(my_fcpl, my_fapl) +!!$ CALL test_attr_dense_limits(my_fcpl, my_fapl) +!!$ CALL test_attr_big(my_fcpl, my_fapl) + CALL test_attr_null_space(my_fcpl, my_fapl, total_error) +!!$ CALL test_attr_deprec(fcpl, my_fapl) + CALL test_attr_many(new_format(i), my_fcpl, my_fapl, total_error) + CALL test_attr_corder_create_basic(my_fcpl, my_fapl, total_error) + CALL test_attr_corder_create_compact(my_fcpl, my_fapl, total_error) +!!$ CALL test_attr_corder_create_dense(my_fcpl, my_fapl) +!!$ CALL test_attr_corder_create_reopen(my_fcpl, my_fapl) +!!$ CALL test_attr_corder_transition(my_fcpl, my_fapl) +!!$ CALL test_attr_corder_delete(my_fcpl, my_fapl) + CALL test_attr_info_by_idx(new_format, my_fcpl, my_fapl, total_error) + CALL test_attr_delete_by_idx(new_format, my_fcpl, my_fapl, total_error) +!!$ CALL test_attr_iterate2(new_format, my_fcpl, my_fapl) +!!$ CALL test_attr_open_by_idx(new_format, my_fcpl, my_fapl) +!!$ CALL test_attr_open_by_name(new_format, my_fcpl, my_fapl) + CALL test_attr_create_by_name(new_format(i), my_fcpl, my_fapl, total_error) + ! /* More complex tests with both "new format" and "shared" attributes */ + IF( use_shared(j) ) THEN +!!$ CALL test_attr_shared_write(my_fcpl, my_fapl) + CALL test_attr_shared_rename(my_fcpl, my_fapl, total_error) + CALL test_attr_shared_delete(my_fcpl, my_fapl, total_error) +!!$ CALL test_attr_shared_unlink(my_fcpl, my_fapl) + END IF +!!$ CALL test_attr_bug1(my_fcpl, my_fapl) + END DO +!!$ ELSE +!!$ CALL test_attr_big(fcpl, my_fapl) +!!$ CALL test_attr_null_space(fcpl, my_fapl) +!!$ CALL test_attr_deprec(fcpl, my_fapl) +!!$ CALL test_attr_many(new_format, fcpl, my_fapl) +!!$ CALL test_attr_info_by_idx(new_format, fcpl, my_fapl) +!!$ CALL test_attr_delete_by_idx(new_format, fcpl, my_fapl) +!!$ CALL test_attr_iterate2(new_format, fcpl, my_fapl) +!!$ CALL test_attr_open_by_idx(new_format, fcpl, my_fapl) +!!$ CALL test_attr_open_by_name(new_format, fcpl, my_fapl) +!!$ CALL test_attr_create_by_name(new_format, fcpl, my_fapl) +!!$ CALL test_attr_bug1(fcpl, my_fapl) + + END IF + END DO + + CALL H5Pclose_f(fcpl, error) + CALL CHECK("H5Pclose", error,total_error) + CALL H5Pclose_f(fcpl2, error) + CALL CHECK("H5Pclose", error,total_error) + + IF(cleanup) CALL h5_cleanup_f("tattr", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + + RETURN +END SUBROUTINE attribute_test_1_8 + +SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error) + +! Needed for get_info_by_name + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE +! - - - arg types - - - + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + INTEGER :: error + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + CHARACTER(LEN=8) :: DSET3_NAME = "Dataset3" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + INTEGER :: curr_dset +!!$ +!!$! - - - local declarations - - - +!!$ +!!$ INTEGER :: max_compact,min_dense,curr_dset,u +!!$ CHARACTER (LEN=NAME_BUF_SIZE) :: attrname +!!$ + INTEGER(HID_T) :: dset1, dset2, dset3 + INTEGER(HID_T) :: my_dataset + + INTEGER :: u + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=7) :: attrname + CHARACTER(LEN=2) :: chr2 + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + + data_dims = 0 + +!!$ INTEGER :: sid +!!$ INTEGER :: attr +!!$ INTEGER :: dcpl +!!$ INTEGER ::is_empty +!!$ INTEGER ::is_dense +!!$ + WRITE(*,*) " - Testing Compact Storage of Attributes with Creation Order Info" + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + ! /* Create dataset creation property list */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error) + CALL check("H5Pset_attr_creation_order",error,total_error) +! ret = H5Pset_attr_creation_order(dcpl, (H5P_CRT_ORDER_TRACKED | H5P_CRT_ORDER_INDEXED)); + + ! /* Query the attribute creation properties */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + +! FIX: need to check optional parameters i.e. h5dcreate1/2_f + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error, dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + +!!$ dset1 = H5Dcreate2(fid, DSET1_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT) +!!$ dset2 = H5Dcreate2(fid, DSET2_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT) +!!$ dset3 = H5Dcreate2(fid, DSET3_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, dcpl, H5P_DEFAULT) + + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 +! CASE DEFAULT +! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT +!!$ is_empty = H5O_is_attr_empty_test(my_dataset) +!!$ CALL VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test") +!!$ is_dense = H5O_is_attr_dense_test(my_dataset) +!!$ CALL VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test") + DO u = 0, max_compact - 1 + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + ! attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT); + ! check with the optional information create2 specs. + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error) + CALL check("h5acreate_f",error,total_error) + + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + +!!$ ret = H5O_num_attrs_test(my_dataset, nattrs) +!!$ CALL CHECK(ret, FAIL, "H5O_num_attrs_test") +!!$ CALL VERIFY(nattrs, (u + 1)) +!!$ is_empty = H5O_is_attr_empty_test(my_dataset) +!!$ CALL VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test") +!!$ is_dense = H5O_is_attr_dense_test(my_dataset) +!!$ CALL VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test") + END DO + END DO + + ! /* Close Datasets */ + CALL h5dclose_f(dset1, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset2, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset3, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + + ! /* Close property list */ + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) + CALL check("h5open_f",error,total_error) + +!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDWR, fapl) +!!$ CALL CHECK(fid, FAIL, "H5Fopen") + + CALL h5dopen_f(fid, DSET1_NAME, dset1, error) + CALL check("h5dopen_f",error,total_error) + CALL h5dopen_f(fid, DSET2_NAME, dset2, error) + CALL check("h5dopen_f",error,total_error) + CALL h5dopen_f(fid, DSET3_NAME, dset3, error) + CALL check("h5dopen_f",error,total_error) + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + CASE DEFAULT + WRITE(*,*) " WARNING: To many data sets! " + END SELECT +!!$ ret = H5O_num_attrs_test(my_dataset, nattrs) +!!$ CALL CHECK(ret, FAIL, "H5O_num_attrs_test") +!!$ CALL VERIFY(nattrs, max_compact, "H5O_num_attrs_test") +!!$ is_empty = H5O_is_attr_empty_test(my_dataset) +!!$ CALL VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test") +!!$ is_dense = H5O_is_attr_dense_test(my_dataset) +!!$ CALL VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test") + + DO u = 0,max_compact-1 + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + ! /* Retrieve information for attribute */ + + CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, & + f_corder_valid, corder, cset, data_size, error, lapl_id = H5P_DEFAULT_F ) !with optional + + CALL check("H5Aget_info_by_name_f", error, total_error) + + ! /* Verify creation order of attribute */ + + CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) + CALL verify("H5Aget_info_by_name_f", corder, u, total_error) + + + ! /* Retrieve information for attribute */ + + CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, & + f_corder_valid, corder, cset, data_size, error) ! without optional + + CALL check("H5Aget_info_by_name_f", error, total_error) + + ! /* Verify creation order of attribute */ + + CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error) + CALL verify("H5Aget_info_by_name_f", corder, u, total_error) + + END DO + END DO + ! /* Close Datasets */ + CALL h5dclose_f(dset1, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset2, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset3, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + +END SUBROUTINE test_attr_corder_create_compact + +SUBROUTINE test_attr_null_space(fcpl, fapl, total_error) +! -------------------------------------------------- + USE HDF5 + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: sid, null_sid + INTEGER(HID_T) :: dataset + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + + INTEGER :: error + + INTEGER :: value_scalar + INTEGER, DIMENSION(1) :: value + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr_sid + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + INTEGER(HSIZE_T) :: storage_size ! attributes storage requirements .MSB. + + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + + LOGICAL :: equal + + ! test: H5Sextent_equal_f + + + data_dims = 0 + +! CHARACTER (LEN=NAME_BUF_SIZE) :: attrname + +! /* Output message about test being performed */ + WRITE(*,*) " - Testing Storing Attributes with 'null' dataspace" + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) +! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + +!!$ empty_filesize = h5_get_file_size(FILENAME) +!!$ IF (empty_filesize < 0) CALL TestErrPrintf("Line %d: file size wrong!\n"C, __LINE__) + ! /* Re-open file */ + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error) + CALL check("h5open_f",error,total_error) + ! /* Create dataspace for dataset attributes */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + ! /* Create "null" dataspace for attribute */ + CALL h5screate_f(H5S_NULL_F, null_sid, error) + CALL check("h5screate_f",error,total_error) + ! /* Create a dataset */ + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error) + CALL check("h5dcreate_f",error,total_error) +!!$ dataset = H5Dcreate2(fid, DSET1_NAME, H5T_NATIVE_UCHAR, sid, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) +!!$ CALL CHECK(dataset, FAIL, "H5Dcreate2") + ! /* Add attribute with 'null' dataspace */ + + ! /* Create attribute */ + CALL h5acreate_f(dataset, "null attr", H5T_NATIVE_INTEGER, null_sid, attr, error) + CALL check("h5acreate_f",error,total_error) + +!!$ CALL HDstrcpy(attrname, "null attr") +!!$ attr = H5Acreate2(dataset, attrname, H5T_NATIVE_UINT, null_sid, H5P_DEFAULT, H5P_DEFAULT) + ! /* Try to read data from the attribute */ + ! /* (shouldn't fail, but should leave buffer alone) */ + value(1) = 103 + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error) + CALL check("h5aread_f",error,total_error) + CALL verify("h5aread_f",value(1),103,total_error) + +! /* Try to read data from the attribute again but*/ +! /* for a scalar */ + + value_scalar = 104 + data_dims(1) = 1 + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value_scalar, data_dims, error) + CALL check("h5aread_f",error,total_error) + CALL verify("h5aread_f",value_scalar,104,total_error) + + CALL h5aget_space_f(attr, attr_sid, error) + CALL check("h5aget_space_f",error,total_error) + + CALL H5Sextent_equal_f(attr_sid, null_sid, equal, error) + CALL check("H5Sextent_equal_f",error,total_error) + CALL Verifylogical("H5Sextent_equal_f",equal,.TRUE.,total_error) + + +!!$ ret = H5Sclose(attr_sid) +!!$ CALL CHECK(ret, FAIL, "H5Sclose") + + CALL h5aget_storage_size_f(attr, storage_size, error) + CALL check("h5aget_storage_size_f",error,total_error) + CALL VERIFY("h5aget_storage_size_f",INT(storage_size),0,total_error) + + CALL h5aget_info_f(attr, f_corder_valid, corder, cset, data_size, error) + CALL VERIFY("h5aget_info_f",INT(data_size),INT(storage_size),total_error) + + + CALL h5aclose_f(attr,error) + CALL check("h5aclose_f",error,total_error) + + +!!$ CALL HDstrcpy(attrname, "null attr #2") +!!$ attr = H5Acreate2(dataset, attrname, H5T_NATIVE_UINT, null_sid, H5P_DEFAULT, H5P_DEFAULT) +!!$ CALL CHECK(attr, FAIL, "H5Acreate2") +!!$ value = 23 +!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, value) +!!$ CALL CHECK(ret, FAIL, "H5Awrite") +!!$ CALL VERIFY(value, 23, "H5Awrite") +!!$ ret = H5Aclose(attr) +!!$ CALL CHECK(ret, FAIL, "H5Aclose") +!!$ ret = H5Dclose(dataset) +!!$ CALL CHECK(ret, FAIL, "H5Dclose") +!!$ ret = H5Fclose(fid) +!!$ CALL CHECK(ret, FAIL, "H5Fclose") +!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDWR, fapl) +!!$ CALL CHECK(fid, FAIL, "H5Fopen") +!!$ dataset = H5Dopen2(fid, DSET1_NAME, H5P_DEFAULT) +!!$ CALL CHECK(dataset, FAIL, "H5Dopen2") +!!$ CALL HDstrcpy(attrname, "null attr #2") +!!$ attr = H5Aopen(dataset, attrname, H5P_DEFAULT) +!!$ CALL CHECK(attr, FAIL, "H5Aopen") +!!$ value = 23 +!!$ ret = H5Aread(attr, H5T_NATIVE_UINT, value) +!!$ CALL CHECK(ret, FAIL, "H5Aread") +!!$ CALL VERIFY(value, 23, "H5Aread") +!!$ attr_sid = H5Aget_space(attr) +!!$ CALL CHECK(attr_sid, FAIL, "H5Aget_space") +!!$ cmp = H5Sextent_equal(attr_sid, null_sid) +!!$ CALL CHECK(cmp, FAIL, "H5Sextent_equal") +!!$ CALL VERIFY(cmp, TRUE, "H5Sextent_equal") + + + CALL H5Sclose_f(attr_sid, error) + CALL check("H5Sclose_f",error,total_error) + + +!!$ ret = H5Sclose(attr_sid) +!!$ CALL CHECK(ret, FAIL, "H5Sclose") +!!$ storage_size = H5Aget_storage_size(attr) +!!$ CALL VERIFY(storage_size, 0, "H5Aget_storage_size") +!!$ ret = H5Aget_info(attr, ainfo) +!!$ CALL CHECK(ret, FAIL, "H5Aget_info") +!!$ CALL VERIFY(ainfo%data_size, storage_size, "H5Aget_info") +!!$ ret = H5Aclose(attr) +!!$ CALL CHECK(ret, FAIL, "H5Aclose") +!!$ CALL HDstrcpy(attrname, "null attr") +!!$ attr = H5Aopen(dataset, attrname, H5P_DEFAULT) +!!$ CALL CHECK(attr, FAIL, "H5Aopen") +!!$ value = 23 +!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, value) +!!$ CALL CHECK(ret, FAIL, "H5Awrite") +!!$ CALL VERIFY(value, 23, "H5Awrite") + + +!!$ CALL H5Aclose_f(attr, error) +!!$ CALL check("H5Aclose_f", error,total_error) +!!$ CALL H5Ddelete_f(fid, DSET1_NAME, H5P_DEFAULT_F, error) +!!$ CALL check("H5Aclose_f", error,total_error) + + CALL H5Dclose_f(dataset, error) + CALL check("H5Dclose_f", error,total_error) + +!!$ ret = H5delete(fid, DSET1_NAME, H5P_DEFAULT) +!!$ CALL CHECK(ret, FAIL, "H5Ldelete") + +! TESTING1 + + CALL H5Fclose_f(fid, error) + CALL check("H5Fclose_f", error,total_error) + + CALL H5Sclose_f(sid, error) + CALL check("H5Sclose_f", error,total_error) + + CALL H5Sclose_f(null_sid, error) + CALL check("H5Sclose_f", error,total_error) + +!!$ filesize = h5_get_file_size(FILENAME) +!!$ CALL VERIFY(filesize, empty_filesize, "h5_get_file_size") + +END SUBROUTINE test_attr_null_space + + +SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + + INTEGER(SIZE_T), PARAMETER :: NAME_BUF_SIZE = 7 + LOGICAL :: new_format + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + + INTEGER :: max_compact,min_dense,u + CHARACTER (LEN=NAME_BUF_SIZE) :: attrname + CHARACTER(LEN=8) :: dsetname + + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + CHARACTER(LEN=8) :: DSET3_NAME = "Dataset3" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + INTEGER :: curr_dset + + INTEGER(HID_T) :: dset1, dset2, dset3 + INTEGER(HID_T) :: my_dataset + INTEGER :: error + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + + CHARACTER(LEN=2) :: chr2 + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + INTEGER :: Input1 + INTEGER :: i + + data_dims = 0 + + + ! /* Create dataspace for dataset & attributes */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Create dataset creation property list */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Query the attribute creation properties */ + + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + ! /* Loop over using index for creation order value */ + DO i = 1, 2 + ! /* Print appropriate test message */ + IF(use_index(i))THEN + WRITE(*,*) " - Testing Creating Attributes By Name w/Creation Order Index" + ELSE + WRITE(*,*) " - Testing Creating Attributes By Name w/o Creation Order Index" + ENDIF + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Set attribute creation order tracking & indexing for object */ + IF(new_format)THEN + + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + + CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) + CALL check("H5Pset_attr_creation_order",error,total_error) + + ENDIF + + ! /* Create datasets */ + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f2",error,total_error) + + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f3",error,total_error) + + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f4",error,total_error) + + + ! /* Work on all the datasets */ + + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + dsetname = DSET1_NAME + CASE (1) + my_dataset = dset2 + dsetname = DSET2_NAME + CASE (2) + my_dataset = dset3 + dsetname = DSET3_NAME + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Check on dataset's attribute storage status */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + !/* Create attributes, up to limit of compact form */ + + DO u = 0, max_compact - 1 + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + CALL H5Acreate_by_name_f(fid, dsetname, attrname, H5T_NATIVE_INTEGER, sid, & + attr, error, lapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) + CALL check("H5Acreate_by_name_f",error,total_error) + + ! /* Write data into the attribute */ + + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify information for NEW attribute */ + CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index, total_error) + ! CALL check("FAILED IN attr_info_by_idx_check",total_error) + ENDDO + + ! /* Verify state of object */ +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, max_compact, "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Test opening attributes stored compactly */ + + CALL attr_open_check(fid, dsetname, my_dataset, u, total_error) + + ! CHECK(ret, FAIL, "attr_open_check"); + ENDDO + + + ! /* Work on all the datasets */ + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + dsetname = DSET1_NAME + CASE (1) + my_dataset = dset2 + dsetname = DSET2_NAME + CASE (2) + my_dataset = dset3 + dsetname = DSET3_NAME +! CASE DEFAULT +! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Create more attributes, to push into dense form */ + DO u = max_compact, max_compact* 2 - 1 + + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL H5Acreate_by_name_f(fid, dsetname, attrname, H5T_NATIVE_INTEGER, sid, & + attr, error, lapl_id=H5P_DEFAULT_F) + CALL check("H5Acreate_by_name",error,total_error) + + ! /* Write data into the attribute */ + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify state of object */ +!!$ if(u >= max_compact) { +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); +!!$ } /* end if */ +!!$ +!!$ /* Verify information for new attribute */ +!!$ ret = attr_info_by_idx_check(my_dataset, attrname, (hsize_t)u, use_index); +!!$ CHECK(ret, FAIL, "attr_info_by_idx_check"); + ENDDO + + ! /* Verify state of object */ +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, (max_compact * 2), "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); + +!!$ if(new_format) { +!!$ /* Retrieve & verify # of records in the name & creation order indices */ +!!$ ret = H5O_attr_dense_info_test(my_dataset, &name_count, &corder_count); +!!$ CHECK(ret, FAIL, "H5O_attr_dense_info_test"); +!!$ if(use_index) +!!$ VERIFY(name_count, corder_count, "H5O_attr_dense_info_test"); +!!$ VERIFY(name_count, (max_compact * 2), "H5O_attr_dense_info_test"); +!!$ } /* end if */ + +!!$ /* Test opening attributes stored compactly */ +!!$ ret = attr_open_check(fid, dsetname, my_dataset, u); +!!$ CHECK(ret, FAIL, "attr_open_check"); + + ENDDO + + ! /* Close Datasets */ + CALL h5dclose_f(dset1, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset2, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset3, error) + CALL check("h5dclose_f",error,total_error) + + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + ENDDO + + ! /* Close property list */ + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_create_by_name + + +SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + + LOGICAL :: new_format + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + CHARACTER(LEN=8) :: DSET3_NAME = "Dataset3" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + INTEGER :: curr_dset + + INTEGER(HID_T) :: dset1, dset2, dset3 + INTEGER(HID_T) :: my_dataset + INTEGER :: error + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + INTEGER(HSIZE_T) :: n + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=2) :: chr2 + + INTEGER :: i, j + + INTEGER, DIMENSION(1) :: attr_integer_data + CHARACTER(LEN=7) :: attrname + + INTEGER(SIZE_T) :: size + CHARACTER(LEN=80) :: tmpname + + INTEGER :: Input1 + + data_dims = 0 +!!$ htri_t is_empty; /* Are there any attributes? */ +!!$ htri_t is_dense; /* Are attributes stored densely? */ +!!$ hsize_t nattrs; /* Number of attributes on object */ +!!$ hsize_t name_count; /* # of records in name index */ +!!$ hsize_t corder_count; /* # of records in creation order index */ +!!$ hbool_t use_index; /* Use index on creation order values */ +!!$ char attrname[NAME_BUF_SIZE]; /* Name of attribute */ +!!$ char tmpname[NAME_BUF_SIZE]; /* Temporary attribute name */ +!!$ unsigned curr_dset; /* Current dataset to work on */ +!!$ unsigned u; /* Local index variable */ +!!$ herr_t ret; /* Generic return value */ + + ! /* Create dataspace for dataset & attributes */ + + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + + ! /* Create dataset creation property list */ + + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + + ! /* Query the attribute creation properties */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + ! /* Loop over using index for creation order value */ + + DO i = 1, 2 + + ! /* Output message about test being performed */ + IF(use_index(i))THEN + WRITE(*,'(A72)') " - Testing Querying Attribute Info By Index w/Creation Order Index" + ELSE + WRITE(*,'(A74)') " - Testing Querying Attribute Info By Index w/o Creation Order Index" + ENDIF + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Set attribute creation order tracking & indexing for object */ + IF(new_format)THEN + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) + CALL check("H5Pset_attr_creation_order",error,total_error) + ENDIF + + ! /* Create datasets */ + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error ) + CALL check("h5dcreate_f",error,total_error) + + ! /* Work on all the datasets */ + + DO curr_dset = 0,NUM_DSETS-1 + + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + !/* Check on dataset's attribute storage status */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Check for query on non-existant attribute */ + + n = 0 + CALL h5aget_info_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, 0_HSIZE_T, & + f_corder_valid, corder, cset, data_size, error, lapl_id=H5P_DEFAULT_F) + CALL VERIFY("h5aget_info_by_idx_f",error,-1,total_error) + + size = 0 + CALL h5aget_name_by_idx_f(my_dataset, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, & + 0_HSIZE_T, tmpname, size, error, lapl_id=H5P_DEFAULT_F) + CALL VERIFY("h5aget_name_by_idx_f",error,-1,total_error) + + + ! /* Create attributes, up to limit of compact form */ + + DO j = 0, max_compact-1 + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') j + attrname = 'attr '//chr2 + + ! attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT); + ! check with the optional information create2 specs. + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Write data into the attribute */ + + attr_integer_data(1) = j + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify information for new attribute */ + + CALL attr_info_by_idx_check(my_dataset, attrname, INT(j,HSIZE_T), use_index(i), total_error ) + + CALL check("attr_info_by_idx_check",error,total_error) + + !CHECK(ret, FAIL, "attr_info_by_idx_check"); + ENDDO + + ! /* Verify state of object */ +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, max_compact, "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Check for out of bound offset queries */ +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, &ainfo, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx"); +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)u, &ainfo, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx"); +!!$ ret = H5Aget_name_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_name_by_idx"); +!!$ +!!$ /* Create more attributes, to push into dense form */ +!!$ for(; u < (max_compact * 2); u++) { +!!$ /* Create attribute */ +!!$ sprintf(attrname, "attr %02u", u); +!!$ attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT); +!!$ CHECK(attr, FAIL, "H5Acreate2"); +!!$ +!!$ /* Write data into the attribute */ +!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, &u); +!!$ CHECK(ret, FAIL, "H5Awrite"); +!!$ +!!$ /* Close attribute */ +!!$ ret = H5Aclose(attr); +!!$ CHECK(ret, FAIL, "H5Aclose"); +!!$ +!!$ /* Verify state of object */ +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); +!!$ +!!$ /* Verify information for new attribute */ +!!$ ret = attr_info_by_idx_check(my_dataset, attrname, (hsize_t)u, use_index); +!!$ CHECK(ret, FAIL, "attr_info_by_idx_check"); +!!$ } /* end for */ +!!$ +!!$ /* Verify state of object */ +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, (max_compact * 2), "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); +!!$ +!!$ if(new_format) { +!!$ /* Retrieve & verify # of records in the name & creation order indices */ +!!$ ret = H5O_attr_dense_info_test(my_dataset, &name_count, &corder_count); +!!$ CHECK(ret, FAIL, "H5O_attr_dense_info_test"); +!!$ if(use_index) +!!$ VERIFY(name_count, corder_count, "H5O_attr_dense_info_test"); +!!$ VERIFY(name_count, (max_compact * 2), "H5O_attr_dense_info_test"); +!!$ } /* end if */ +!!$ +!!$ /* Check for out of bound offset queries */ +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, &ainfo, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx"); +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)u, &ainfo, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_info_by_idx"); +!!$ ret = H5Aget_name_by_idx(my_dataset, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Aget_name_by_idx"); +!!$ } /* end for */ +!!$ + +!!$ } /* end for */ +!!$ + + ENDDO + + + ! /* Close Datasets */ + CALL h5dclose_f(dset1, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset2, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset3, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + END DO + + ! /* Close property list */ + CALL h5pclose_f(dcpl,error) + CALL check("h5pclose_f", error, total_error) + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_info_by_idx + + +SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error ) + + USE HDF5 + + IMPLICIT NONE + + INTEGER :: error, total_error + + INTEGER :: obj_id + CHARACTER(LEN=*) :: attrname + INTEGER(HSIZE_T) :: n + LOGICAL :: use_index + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + + INTEGER(SIZE_T) :: NAME_BUF_SIZE = 7 + CHARACTER(LEN=7) :: tmpname + +!!$ +!!$ INTEGER :: const +!!$ INTEGER :: har +!!$ INTEGER :: attrname +!!$ INTEGER :: hsize_t +!!$ INTEGER :: hbool_t +!!$ INTEGER :: se_index +!!$ INTEGER :: old_nerrs +!!$ CHARACTER (LEN=NAME_BUF_SIZE) :: tmpname +!!$ ainfo +!!$ ret +!!$ old_nerrs = GetTestNumErrs() + + ! /* Verify the information for first attribute, in increasing creation order */ + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL verify("h5aget_info_by_idx_f",corder,0,total_error) + + ! /* Verify the information for new attribute, in increasing creation order */ + + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, n, & + f_corder_valid, corder, cset, data_size, error) + + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) + + ! /* Verify the name for new link, in increasing creation order */ + +!!$ CALL HDmemset(tmpname, 0, (size_t)) + + CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, & + n, tmpname, NAME_BUF_SIZE, error) + CALL check("h5aget_name_by_idx_f",error,total_error) + + IF(TRIM(attrname).NE.TRIM(tmpname))THEN + error = -1 + ENDIF + CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) + + ! /* Don't test "native" order if there is no creation order index, since + ! * there's not a good way to easily predict the attribute's order in the name + ! * index. + ! */ + IF (use_index) THEN + ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + ! /* Verify the information for first attribute, in native creation order */ + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, INT(0,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) + + ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + + ! /* Verify the information for new attribute, in native creation order */ + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) + + ! /* Verify the name for new link, in increasing native order */ + ! CALL HDmemset(tmpname, 0, (size_t)) + CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, & + n, tmpname, NAME_BUF_SIZE, error) + CALL check("h5aget_name_by_idx_f",error,total_error) + IF(TRIM(attrname).NE.TRIM(tmpname))THEN + WRITE(*,*) "ERROR: attribute name size wrong!" + error = -1 + ENDIF + CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) + END IF + + + ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, n, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) + + ! CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_DEC_F, 0_HSIZE_T, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) +!!$ CALL HDmemset(tmpname, 0, (size_t)) +!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) +!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx") +!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__) +!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_HSIZE_T, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) +!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, n, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) +!!$ CALL HDmemset(tmpname, 0, (size_t)) +!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) +!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx") +!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__) +!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, n, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error) +!!$ CALL HDmemset(ainfo, 0, SIZEOF(ainfo) + CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_NAME_F, H5_ITER_DEC_F, 0_HSIZE_T, & + f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_by_idx_f",error,total_error) + CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error) +!!$ CALL HDmemset(tmpname, 0, (size_t)) +!!$ ret = H5Aget_name_by_idx(obj_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) +!!$ CALL CHECK(ret, FAIL, "H5Aget_name_by_idx") +!!$ IF (HDstrcmp(attrname, tmpname)) CALL TestErrPrintf("Line %d: attribute name size wrong!\n"C, __LINE__) + +END SUBROUTINE attr_info_by_idx_check + + +SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error) + +!/**************************************************************** +!** +!** test_attr_shared_rename(): Test basic H5A (attribute) code. +!** Tests renaming shared attributes in "compact" & "dense" storage +!** +!****************************************************************/ + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid, big_sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + + INTEGER(HID_T) :: dataset, dataset2 + + INTEGER :: error + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr_tid + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=2) :: chr2 + + + INTEGER, DIMENSION(1) :: attr_integer_data + CHARACTER(LEN=7) :: attrname + CHARACTER(LEN=11) :: attrname2 + + CHARACTER(LEN=1), PARAMETER :: chr1 = '.' + + INTEGER :: u + INTEGER, PARAMETER :: SPACE1_RANK = 3 + INTEGER, PARAMETER :: NX = 20 + INTEGER, PARAMETER :: NY = 5 + INTEGER, PARAMETER :: NZ = 10 + INTEGER(HID_T) :: my_fcpl + + CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type" + + INTEGER, PARAMETER :: SPACE1_DIM1 = 4 + INTEGER, PARAMETER :: SPACE1_DIM2 = 8 + INTEGER, PARAMETER :: SPACE1_DIM3 = 10 + + + INTEGER :: test_shared + INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension + INTEGER :: arank = 1 ! Attribure rank + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Renaming Shared & Unshared Attributes in Compact & Dense Storage" +!!$ /* Initialize "big" attribute data */ +!!$ CALL HDmemset(big_value, 1, SIZEOF(big_value) + + ! /* Create dataspace for dataset */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Create "big" dataspace for "large" attributes */ + + CALL h5screate_simple_f(arank, adims2, big_sid, error) + CALL check("h5screate_simple_f",error,total_error) + + ! /* Loop over type of shared components */ + DO test_shared = 0, 2 + ! /* Make copy of file creation property list */ + CALL H5Pcopy_f(fcpl, my_fcpl, error) + CALL check("H5Pcopy",error,total_error) + + ! /* Set up datatype for attributes */ + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error) + CALL check("H5Tcopy",error,total_error) + + ! /* Special setup for each type of shared components */ + + IF( test_shared .EQ. 0) THEN + ! /* Make attributes > 500 bytes shared */ + CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error) + CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes"); + CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) + CALL check(" H5Pset_shared_mesg_index_f",error, total_error) + +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + ELSE + ! /* Set up copy of file creation property list */ + CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error) +!!$ +!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes"); +!!$ + ! /* Make attributes > 500 bytes shared */ + CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); +!!$ + ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */ + CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + ENDIF + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Close FCPL copy */ + CALL h5pclose_f(my_fcpl, error) + CALL check("h5pclose_f", error, total_error) + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + +!!$ +!!$ /* Get size of file */ +!!$ empty_filesize = h5_get_file_size(FILENAME); +!!$ if(empty_filesize < 0) +!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__); + + ! /* Re-open file */ + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) + CALL check("h5open_f",error,total_error) + + ! /* Commit datatype to file */ + IF(test_shared.EQ.2) THEN + CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F,error) + CALL check("H5Tcommit",error,total_error) + ENDIF + + ! /* Set up to query the object creation properties */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Create datasets */ + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + + ! /* Check on dataset's message storage status */ +!!$ if(test_shared != 0) { +!!$ /* Datasets' datatypes can be shared */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 1, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ /* Datasets' dataspace can be shared */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 1, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ + + ! /* Retrieve limits for compact/dense attribute storage */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + ! /* Close property list */ + CALL h5pclose_f(dcpl,error) + CALL check("h5pclose_f", error, total_error) +!!$ +!!$ +!!$ /* Check on datasets' attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ is_dense = H5O_is_attr_dense_test(dataset2); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + ! /* Add attributes to each dataset, until after converting to dense storage */ + + + DO u = 0, (max_compact * 2) - 1 + + ! /* Create attribute name */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + ! /* Alternate between creating "small" & "big" attributes */ + + IF(MOD(u+1,2).EQ.0)THEN + ! /* Create "small" attribute on first dataset */ + + CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + +!!$ /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); + + ! /* Write data into the attribute */ + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + ELSE + ! Create "big" attribute on first dataset */ + + CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) +!!$ + ! Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); + + ! Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ + ! Write data into the attribute */ + + data_dims(1) = 1 + attr_integer_data(1) = u + 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); + ENDIF + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ if(u < max_compact) +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ else +!!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); +!!$ +!!$ + ! /* Alternate between creating "small" & "big" attributes */ + IF(MOD(u+1,2).EQ.0)THEN + + ! /* Create "small" attribute on second dataset */ + + CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ + ! /* Write data into the attribute */ + + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + ELSE + + ! /* Create "big" attribute on second dataset */ + + CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + +! /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +! /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ +! /* Write data into the attribute */ + + + attr_integer_data(1) = u + 1 + data_dims(1) = 1 +! CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) +! CALL check("h5awrite_f",error,total_error) + + +! /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 2, "H5A_get_shared_rc_test"); + + ENDIF + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset2); +!!$ if(u < max_compact) +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ else +!!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); + + + ! /* Create new attribute name */ + + WRITE(chr2,'(I2.2)') u + attrname2 = 'new attr '//chr2 + + + ! /* Change second dataset's attribute's name */ + + CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname, attrname2, error, lapl_id=H5P_DEFAULT_F) + CALL check("H5Arename_by_name_f",error,total_error) + + ! /* Check refcount on attributes now */ + + ! /* Check refcount on renamed attribute */ + + CALL H5Aopen_f(dataset2, attrname2, attr, error, aapl_id=H5P_DEFAULT_F) + CALL check("H5Aopen_f",error,total_error) + +!!$ +!!$ IF(MOD(u+1,2).EQ.0)THEN +!!$ ! /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ CALL VERIFY("H5A_is_shared_test", error, -1) +!!$ ELSE +!!$ ! /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +!!$ /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test") +!!$ ENDIF + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check refcount on original attribute */ + CALL H5Aopen_f(dataset, attrname, attr, error) + CALL check("H5Aopen",error,total_error) + +!!$ if(u % 2) { +!!$ /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ } /* end if */ +!!$ else { +!!$ /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +!!$ /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ } /* end else */ + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + + ! /* Change second dataset's attribute's name back to original */ + + CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname2, attrname, error) + CALL check("H5Arename_by_name_f",error,total_error) + + ! /* Check refcount on attributes now */ + + ! /* Check refcount on renamed attribute */ + CALL H5Aopen_f(dataset2, attrname, attr, error) + CALL check("H5Aopen",error,total_error) +!!$ +!!$ if(u % 2) { +!!$ /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ } /* end if */ +!!$ else { +!!$ /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +!!$ /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 2, "H5A_get_shared_rc_test"); +!!$ } /* end else */ + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check refcount on original attribute */ + + ! /* Check refcount on renamed attribute */ + CALL H5Aopen_f(dataset, attrname, attr, error) + CALL check("H5Aopen",error,total_error) + +!!$ if(u % 2) { +!!$ /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ } /* end if */ +!!$ else { +!!$ /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +!!$ /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 2, "H5A_get_shared_rc_test"); +!!$ } /* end else */ + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ENDDO + + ! /* Close attribute's datatype */ + CALL h5tclose_f(attr_tid, error) + CALL check("h5tclose_f",error,total_error) + + ! /* Close attribute's datatype */ + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dataset2, error) + CALL check("h5dclose_f",error,total_error) + +!!$ /* Check on shared message status now */ +!!$ if(test_shared != 0) { +!!$ if(test_shared == 1) { +!!$ /* Check on datatype storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 2, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ +!!$ +!!$ /* Check on dataspace storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 2, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ + + ! /* Unlink datasets with attributes */ + CALL H5Ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) + CALL check("HLdelete",error,total_error) + CALL H5Ldelete_f(fid, DSET2_NAME, error) + CALL check("HLdelete",error,total_error) + + !/* Unlink committed datatype */ + IF(test_shared == 2)THEN + CALL H5Ldelete_f(fid, TYPE1_NAME, error) + CALL check("HLdelete_f",error,total_error) + ENDIF + + ! /* Check on attribute storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_ATTR_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ if(test_shared != 0) { +!!$ /* Check on datatype storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ /* Check on dataspace storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + ! /* Check size of file */ + !filesize = h5_get_file_size(FILENAME); + !VERIFY(filesize, empty_filesize, "h5_get_file_size"); + ENDDO + + ! /* Close dataspaces */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(big_sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_shared_rename + + +SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: new_format + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + CHARACTER(LEN=8) :: DSET3_NAME = "Dataset3" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + INTEGER :: curr_dset + + INTEGER(HID_T) :: dset1, dset2, dset3 + INTEGER(HID_T) :: my_dataset + + INTEGER :: error + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=2) :: chr2 + + INTEGER :: i + + INTEGER, DIMENSION(1) :: attr_integer_data + CHARACTER(LEN=7) :: attrname + + INTEGER(SIZE_T) :: size + CHARACTER(LEN=8) :: tmpname + CHARACTER(LEN=1), PARAMETER :: chr1 = '.' + + INTEGER :: idx_type + INTEGER :: order + INTEGER :: u + INTEGER :: Input1 + + data_dims = 0 + +!!$test_attr_delete_by_idx(hbool_t new_format, hid_t fcpl, hid_t fapl) +!!${ +!!$ hid_t fid; /* HDF5 File ID */ +!!$ hid_t dset1, dset2, dset3; /* Dataset IDs */ +!!$ hid_t my_dataset; /* Current dataset ID */ +!!$ hid_t sid; /* Dataspace ID */ +!!$ hid_t attr; /* Attribute ID */ +!!$ hid_t dcpl; /* Dataset creation property list ID */ +!!$ H5A_info_t ainfo; /* Attribute information */ +!!$ unsigned max_compact; /* Maximum # of links to store in group compactly */ +!!$ unsigned min_dense; /* Minimum # of links to store in group "densely" */ +!!$ htri_t is_empty; /* Are there any attributes? */ +!!$ htri_t is_dense; /* Are attributes stored densely? */ +!!$ hsize_t nattrs; /* Number of attributes on object */ +!!$ hsize_t name_count; /* # of records in name index */ +!!$ hsize_t corder_count; /* # of records in creation order index */ +!!$ H5_index_t idx_type; /* Type of index to operate on */ +!!$ H5_iter_order_t order; /* Order within in the index */ +!!$ hbool_t use_index; /* Use index on creation order values */ +!!$ char attrname[NAME_BUF_SIZE]; /* Name of attribute */ +!!$ char tmpname[NAME_BUF_SIZE]; /* Temporary attribute name */ +!!$ unsigned curr_dset; /* Current dataset to work on */ +!!$ unsigned u; /* Local index variable */ +!!$ herr_t ret; /* Generic return value */ +!!$ + + ! /* Create dataspace for dataset & attributes */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Create dataset creation property list */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Query the attribute creation properties */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + + !/* Loop over operating on different indices on link fields */ + DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F + + ! /* Loop over operating in different orders */ + DO order = H5_ITER_INC_F, H5_ITER_DEC_F + + ! /* Loop over using index for creation order value */ + DO i = 1, 2 + + ! /* Print appropriate test message */ + IF(idx_type .EQ. H5_INDEX_CRT_ORDER_F)THEN + IF(order .EQ. H5_ITER_INC_F) THEN + IF(use_index(i))THEN + WRITE(*,'(A102)') & + " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/Creation Order Index" + ELSE + WRITE(*,'(A104)') & + " - Testing Deleting Attribute By Creation Order Index in Increasing Order w/o Creation Order Index" + ENDIF + ELSE + IF(use_index(i))THEN + WRITE(*,'(A102)') & + " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/Creation Order Index" + ELSE + WRITE(*,'(A104)') & + " - Testing Deleting Attribute By Creation Order Index in Decreasing Order w/o Creation Order Index" + ENDIF + ENDIF + ELSE + IF(order .EQ. H5_ITER_INC_F)THEN + IF(use_index(i))THEN + WRITE(*,'(7X,A86)')"- Testing Deleting Attribute By Name Index in Increasing Order w/Creation Order Index" + ELSE + WRITE(*,'(7X,A88)')"- Testing Deleting Attribute By Name Index in Increasing Order w/o Creation Order Index" + ENDIF + ELSE + IF(use_index(i))THEN + WRITE(*,'(7X,A86)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/Creation Order Index" + ELSE + WRITE(*,'(7X,A88)') "- Testing Deleting Attribute By Name Index in Decreasing Order w/o Creation Order Index" + ENDIF + ENDIF + ENDIF + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Set attribute creation order tracking & indexing for object */ + IF(new_format)THEN + + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + + CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) + CALL check("H5Pset_attr_creation_order",error,total_error) + + ENDIF + + ! /* Create datasets */ + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl ) + CALL check("h5dcreate_f2",error,total_error) + + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dset2, error, dcpl ) + CALL check("h5dcreate_f3",error,total_error) + + CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl ) + CALL check("h5dcreate_f4",error,total_error) + + ! /* Work on all the datasets */ + + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Check on dataset's attribute storage status */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Check for deleting non-existant attribute */ + CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F) + CALL VERIFY("H5Adelete_by_idx_f",error,-1,total_error) + + ! /* Create attributes, up to limit of compact form */ + DO u = 0, max_compact - 1 + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Write data into the attribute */ + attr_integer_data(1) = u + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify information for new attribute */ + CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error ) + + ENDDO + + + + ! /* Verify state of object */ + +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, max_compact, "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + !/* Check for out of bound deletions */ + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F) + CALL VERIFY("H5Adelete_by_idx_f",error,-1,total_error) + + ENDDO + + + DO curr_dset = 0, NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Delete attributes from compact storage */ + + DO u = 0, max_compact - 2 + + ! /* Delete first attribute in appropriate order */ + + + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error) + CALL check("H5Adelete_by_idx_f",error,total_error) + + + ! /* Verify the attribute information for first attribute in appropriate order */ + ! HDmemset(&ainfo, 0, sizeof(ainfo)); + + CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, & + f_corder_valid, corder, cset, data_size, error) + + IF(new_format)THEN + IF(order.EQ.H5_ITER_INC_F)THEN + CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error) + ENDIF + ELSE + CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error) + ENDIF + + ! /* Verify the name for first attribute in appropriate order */ + ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); + + size = 7 ! *CHECK* IF NOT THE SAME SIZE + CALL h5aget_name_by_idx_f(my_dataset, ".", idx_type, order,INT(0,hsize_t), & + tmpname, size, error, lapl_id=H5P_DEFAULT_F) + CALL check('h5aget_name_by_idx_f',error,total_error) + IF(order .EQ. H5_ITER_INC_F)THEN + WRITE(chr2,'(I2.2)') u + 1 + attrname = 'attr '//chr2 + ELSE + WRITE(chr2,'(I2.2)') max_compact - (u + 2) + attrname = 'attr '//chr2 + ENDIF + IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1 + CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) + ENDDO + + ! /* Delete last attribute */ + + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error) + CALL check("H5Adelete_by_idx_f",error,total_error) + + + ! /* Verify state of attribute storage (empty) */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); + ENDDO + +! /* Work on all the datasets */ + + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Create more attributes, to push into dense form */ + + DO u = 0, (max_compact * 2) - 1 + + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + + ! /* Write data into the attribute */ + attr_integer_data(1) = u + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify state of object */ + IF(u .GE. max_compact)THEN +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); + ENDIF + + ! /* Verify information for new attribute */ +!!$ CALL check("attr_info_by_idx_check",error,total_error) + ENDDO + + ! /* Verify state of object */ +!!$ ret = H5O_num_attrs_test(my_dataset, &nattrs); +!!$ CHECK(ret, FAIL, "H5O_num_attrs_test"); +!!$ VERIFY(nattrs, (max_compact * 2), "H5O_num_attrs_test"); +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, FALSE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); +!!$ + IF(new_format)THEN +!!$ ! /* Retrieve & verify # of records in the name & creation order indices */ +!!$ ret = H5O_attr_dense_info_test(my_dataset, &name_count, &corder_count); +!!$ CHECK(ret, FAIL, "H5O_attr_dense_info_test"); +!!$ IF(use_index) +!!$ VERIFY(name_count, corder_count, "H5O_attr_dense_info_test"); +!!$ VERIFY(name_count, (max_compact * 2), "H5O_attr_dense_info_test"); + ENDIF + + ! /* Check for out of bound deletion */ + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error) + CALL VERIFY("H5Adelete_by_idx_f",error,-1,total_error) + ENDDO + + ! /* Work on all the datasets */ + + DO curr_dset = 0,NUM_DSETS-1 + SELECT CASE (curr_dset) + CASE (0) + my_dataset = dset1 + CASE (1) + my_dataset = dset2 + CASE (2) + my_dataset = dset3 + ! CASE DEFAULT + ! CALL HDassert(0.AND."Toomanydatasets!") + END SELECT + + ! /* Delete attributes from dense storage */ + + DO u = 0, (max_compact * 2) - 1 - 1 + + ! /* Delete first attribute in appropriate order */ + + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error) + CALL check("H5Adelete_by_idx_f",error,total_error) + + + ! /* Verify the attribute information for first attribute in appropriate order */ +!!$ HDmemset(&ainfo, 0, sizeof(ainfo)); + + + CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + + + IF(new_format)THEN + IF(order.EQ.H5_ITER_INC_F)THEN + CALL VERIFY("H5Aget_info_by_idx_f",corder,u + 1,total_error) + ENDIF + ELSE + CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error) + ENDIF + + + ! /* Verify the name for first attribute in appropriate order */ + ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); + + size = 7 ! *CHECK* if not the correct size + CALL h5aget_name_by_idx_f(my_dataset, ".", idx_type, order,INT(0,hsize_t), & + tmpname, size, error) + + IF(order .EQ. H5_ITER_INC_F)THEN + WRITE(chr2,'(I2.2)') u + 1 + attrname = 'attr '//chr2 + ELSE + WRITE(chr2,'(I2.2)') max_compact * 2 - (u + 2) + attrname = 'attr '//chr2 + ENDIF + IF(TRIM(attrname).NE.TRIM(tmpname)) error = -1 + CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error) + + + ENDDO + ! /* Delete last attribute */ + + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error, lapl_id=H5P_DEFAULT_F) + CALL check("H5Adelete_by_idx_f",error,total_error) + ! /* Verify state of attribute storage (empty) */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); + + !/* Check for deletion on empty attribute storage again */ + CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error) + CALL VERIFY("H5Adelete_by_idx_f",error,-1,total_error) + ENDDO + + +!!$ +!!$ +!!$ /* Delete attributes in middle */ +!!$ +!!$ +!!$ /* Work on all the datasets */ +!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) { +!!$ switch(curr_dset) { +!!$ case 0: +!!$ my_dataset = dset1; +!!$ break; +!!$ +!!$ case 1: +!!$ my_dataset = dset2; +!!$ break; +!!$ +!!$ case 2: +!!$ my_dataset = dset3; +!!$ break; +!!$ +!!$ default: +!!$ HDassert(0 && "Too many datasets!"); +!!$ } /* end switch */ +!!$ +!!$ /* Create attributes, to push into dense form */ +!!$ for(u = 0; u < (max_compact * 2); u++) { +!!$ /* Create attribute */ +!!$ sprintf(attrname, "attr %02u", u); +!!$ attr = H5Acreate2(my_dataset, attrname, H5T_NATIVE_UINT, sid, H5P_DEFAULT, H5P_DEFAULT); +!!$ CHECK(attr, FAIL, "H5Acreate2"); +!!$ +!!$ /* Write data into the attribute */ +!!$ ret = H5Awrite(attr, H5T_NATIVE_UINT, &u); +!!$ CHECK(ret, FAIL, "H5Awrite"); +!!$ +!!$ /* Close attribute */ +!!$ ret = H5Aclose(attr); +!!$ CHECK(ret, FAIL, "H5Aclose"); +!!$ +!!$ /* Verify state of object */ +!!$ if(u >= max_compact) { +!!$ is_dense = H5O_is_attr_dense_test(my_dataset); +!!$ VERIFY(is_dense, (new_format ? TRUE : FALSE), "H5O_is_attr_dense_test"); +!!$ } /* end if */ +!!$ +!!$ /* Verify information for new attribute */ +!!$ ret = attr_info_by_idx_check(my_dataset, attrname, (hsize_t)u, use_index); +!!$ CHECK(ret, FAIL, "attr_info_by_idx_check"); +!!$ } /* end for */ +!!$ } /* end for */ +!!$ +!!$ /* Work on all the datasets */ +!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) { +!!$ switch(curr_dset) { +!!$ case 0: +!!$ my_dataset = dset1; +!!$ break; +!!$ +!!$ case 1: +!!$ my_dataset = dset2; +!!$ break; +!!$ +!!$ case 2: +!!$ my_dataset = dset3; +!!$ break; +!!$ +!!$ default: +!!$ HDassert(0 && "Too many datasets!"); +!!$ } /* end switch */ +!!$ +!!$ /* Delete every other attribute from dense storage, in appropriate order */ +!!$ for(u = 0; u < max_compact; u++) { +!!$ /* Delete attribute */ +!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT); +!!$ CHECK(ret, FAIL, "H5Adelete_by_idx"); +!!$ +!!$ /* Verify the attribute information for first attribute in appropriate order */ +!!$ HDmemset(&ainfo, 0, sizeof(ainfo)); +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, &ainfo, H5P_DEFAULT); +!!$ if(new_format) { +!!$ if(order == H5_ITER_INC) { +!!$ VERIFY(ainfo.corder, ((u * 2) + 1), "H5Aget_info_by_idx"); +!!$ } /* end if */ +!!$ else { +!!$ VERIFY(ainfo.corder, ((max_compact * 2) - ((u * 2) + 2)), "H5Aget_info_by_idx"); +!!$ } /* end else */ +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for first attribute in appropriate order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ ret = H5Aget_name_by_idx(my_dataset, ".", idx_type, order, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT); +!!$ if(order == H5_ITER_INC) +!!$ sprintf(attrname, "attr %02u", ((u * 2) + 1)); +!!$ else +!!$ sprintf(attrname, "attr %02u", ((max_compact * 2) - ((u * 2) + 2))); +!!$ ret = HDstrcmp(attrname, tmpname); +!!$ VERIFY(ret, 0, "H5Aget_name_by_idx"); +!!$ } /* end for */ +!!$ } /* end for */ +!!$ +!!$ /* Work on all the datasets */ +!!$ for(curr_dset = 0; curr_dset < NUM_DSETS; curr_dset++) { +!!$ switch(curr_dset) { +!!$ case 0: +!!$ my_dataset = dset1; +!!$ break; +!!$ +!!$ case 1: +!!$ my_dataset = dset2; +!!$ break; +!!$ +!!$ case 2: +!!$ my_dataset = dset3; +!!$ break; +!!$ +!!$ default: +!!$ HDassert(0 && "Too many datasets!"); +!!$ } /* end switch */ +!!$ +!!$ /* Delete remaining attributes from dense storage, in appropriate order */ +!!$ for(u = 0; u < (max_compact - 1); u++) { +!!$ /* Delete attribute */ +!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT); +!!$ CHECK(ret, FAIL, "H5Adelete_by_idx"); +!!$ +!!$ /* Verify the attribute information for first attribute in appropriate order */ +!!$ HDmemset(&ainfo, 0, sizeof(ainfo)); +!!$ ret = H5Aget_info_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, &ainfo, H5P_DEFAULT); +!!$ if(new_format) { +!!$ if(order == H5_ITER_INC) { +!!$ VERIFY(ainfo.corder, ((u * 2) + 3), "H5Aget_info_by_idx"); +!!$ } /* end if */ +!!$ else { +!!$ VERIFY(ainfo.corder, ((max_compact * 2) - ((u * 2) + 4)), "H5Aget_info_by_idx"); +!!$ } /* end else */ +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for first attribute in appropriate order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ ret = H5Aget_name_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT); +!!$ if(order == H5_ITER_INC) +!!$ sprintf(attrname, "attr %02u", ((u * 2) + 3)); +!!$ else +!!$ sprintf(attrname, "attr %02u", ((max_compact * 2) - ((u * 2) + 4))); +!!$ ret = HDstrcmp(attrname, tmpname); +!!$ VERIFY(ret, 0, "H5Aget_name_by_idx"); +!!$ } /* end for */ +!!$ +!!$ /* Delete last attribute */ +!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT); +!!$ CHECK(ret, FAIL, "H5Adelete_by_idx"); +!!$ +!!$ /* Verify state of attribute storage (empty) */ +!!$ is_empty = H5O_is_attr_empty_test(my_dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ +!!$ /* Check for deletion on empty attribute storage again */ +!!$ ret = H5Adelete_by_idx(my_dataset, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Adelete_by_idx"); +!!$ } /* end for */ + + ! /* Close Datasets */ + CALL h5dclose_f(dset1, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset2, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dset3, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + ENDDO + ENDDO + ENDDO + + ! /* Close property list */ + CALL h5pclose_f(dcpl,error) + CALL check("h5pclose_f", error, total_error) + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_delete_by_idx + +SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error) + +!/**************************************************************** +!** +!** test_attr_shared_delete(): Test basic H5A (attribute) code. +!** Tests deleting shared attributes in "compact" & "dense" storage +!** +!****************************************************************/ + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid, big_sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2" + INTEGER, PARAMETER :: NUM_DSETS = 3 + + + INTEGER(HID_T) :: dataset, dataset2 + + INTEGER :: error + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HID_T) :: attr_tid + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=2) :: chr2 + + INTEGER, DIMENSION(1) :: attr_integer_data + CHARACTER(LEN=7) :: attrname + + CHARACTER(LEN=1), PARAMETER :: chr1 = '.' + + INTEGER :: u + INTEGER, PARAMETER :: SPACE1_RANK = 3 + INTEGER, PARAMETER :: NX = 20 + INTEGER, PARAMETER :: NY = 5 + INTEGER, PARAMETER :: NZ = 10 + INTEGER(HID_T) :: my_fcpl + + CHARACTER(LEN=5), PARAMETER :: TYPE1_NAME = "/Type" + + INTEGER :: test_shared + INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension + INTEGER :: arank = 1 ! Attribure rank + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Deleting Shared & Unshared Attributes in Compact & Dense Storage" + + ! /* Initialize "big" attribute DATA */ +!!$ HDmemset(big_value, 1, sizeof(big_value)); +!!$ + ! /* Create dataspace for dataset */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + !/* Create "big" dataspace for "large" attributes */ + + CALL h5screate_simple_f(arank, adims2, big_sid, error) + CALL check("h5screate_simple_f",error,total_error) + + ! /* Loop over type of shared components */ + + DO test_shared = 0, 2 + + ! /* Make copy of file creation property list */ + + CALL H5Pcopy_f(fcpl, my_fcpl, error) + CALL check("H5Pcopy",error,total_error) + + ! /* Set up datatype for attributes */ + + CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error) + CALL check("H5Tcopy",error,total_error) + + ! /* Special setup for each type of shared components */ + IF( test_shared .EQ. 0) THEN + ! /* Make attributes > 500 bytes shared */ + CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error) + CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes"); + CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) + CALL check(" H5Pset_shared_mesg_index_f",error, total_error) + +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + ELSE + ! /* Set up copy of file creation property list */ + CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error) +!!$ +!!$ CHECK_I(ret, "H5Pset_shared_mesg_nindexes"); +!!$ + ! /* Make attributes > 500 bytes shared */ + CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); +!!$ + ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */ + CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error) +!!$ CHECK_I(ret, "H5Pset_shared_mesg_index"); + ENDIF + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Close FCPL copy */ + CALL h5pclose_f(my_fcpl, error) + CALL check("h5pclose_f", error, total_error) + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) +!!$ +!!$ /* Get size of file */ +!!$ empty_filesize = h5_get_file_size(FILENAME); +!!$ if(empty_filesize < 0) +!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__); + + ! /* Re-open file */ + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl) + CALL check("h5open_f",error,total_error) + + ! /* Commit datatype to file */ + + IF(test_shared.EQ.2) THEN + CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F,error) + CALL check("H5Tcommit",error,total_error) + ENDIF + + ! /* Set up to query the object creation properties */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Create datasets */ + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl ) + CALL check("h5dcreate_f",error,total_error) + + ! /* Check on dataset's message storage status */ +!!$ if(test_shared != 0) { +!!$ /* Datasets' datatypes can be shared */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 1, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ /* Datasets' dataspace can be shared */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 1, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ +!!$ + ! /* Retrieve limits for compact/dense attribute storage */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + ! /* Close property list */ + CALL h5pclose_f(dcpl,error) + CALL check("h5pclose_f", error, total_error) +!!$ +!!$ /* Check on datasets' attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ is_dense = H5O_is_attr_dense_test(dataset2); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ + ! /* Add attributes to each dataset, until after converting to dense storage */ + + DO u = 0, (max_compact * 2) - 1 + + ! /* Create attribute name */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + ! /* Alternate between creating "small" & "big" attributes */ + + IF(MOD(u+1,2).EQ.0)THEN + ! /* Create "small" attribute on first dataset */ + + CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + +!!$ /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); + + ! /* Write data into the attribute */ + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + ELSE + ! Create "big" attribute on first dataset */ + + CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error) + CALL check("h5acreate_f",error,total_error) +!!$ + ! Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); + + ! Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ + ! Write data into the attribute */ + + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); + ENDIF + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ if(u < max_compact) +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ else +!!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); +!!$ +!!$ + ! /* Alternate between creating "small" & "big" attributes */ + IF(MOD(u+1,2).EQ.0)THEN + + ! /* Create "small" attribute on second dataset */ + + CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error) + CALL check("h5acreate_f",error,total_error) + + ! /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ + ! /* Write data into the attribute */ + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + ELSE + + ! /* Create "big" attribute on second dataset */ + + CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + +! /* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +! /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ +! /* Write data into the attribute */ + + + attr_integer_data(1) = u + 1 + data_dims(1) = 1 + CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + +! /* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 2, "H5A_get_shared_rc_test"); + + ENDIF + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset2); +!!$ if(u < max_compact) +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); +!!$ else +!!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); + ENDDO + + ! /* Delete attributes from second dataset */ + + DO u = 0, max_compact*2-1 + + ! /* Create attribute name */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + ! /* Delete second dataset's attribute */ + CALL H5Adelete_by_name_f(fid, DSET2_NAME, attrname,error,lapl_id=H5P_DEFAULT_F) + CALL check("H5Adelete_by_name", error, total_error) + +!!$ /* Check refcount on attributes now */ +!!$ +!!$ /* Check refcount on first dataset's attribute */ + + CALL h5aopen_f(dataset, attrname, attr, error, aapl_id=H5P_DEFAULT_F) + CALL check("h5aopen_f",error,total_error) + +!!$ +!!$ if(u % 2) { +! /* Check that attribute is not shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, FALSE, "H5A_is_shared_test"); +!!$ } /* end if */ +!!$ else { +!/* Check that attribute is shared */ +!!$ is_shared = H5A_is_shared_test(attr); +!!$ VERIFY(is_shared, TRUE, "H5A_is_shared_test"); +!!$ +!/* Check refcount for attribute */ +!!$ ret = H5A_get_shared_rc_test(attr, &shared_refcount); +!!$ CHECK(ret, FAIL, "H5A_get_shared_rc_test"); +!!$ VERIFY(shared_refcount, 1, "H5A_get_shared_rc_test"); +!!$ } /* end else */ + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + ENDDO + + ! /* Close attribute's datatype */ + + CALL h5tclose_f(attr_tid, error) + CALL check("h5tclose_f",error,total_error) + + ! /* Close Datasets */ + + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + CALL h5dclose_f(dataset2, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Check on shared message status now */ +!!$ if(test_shared != 0) { +!!$ if(test_shared == 1) { + ! /* Check on datatype storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 2, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ +!!$ +!!$ /* Check on dataspace storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 2, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ +!!$ + ! /* Unlink datasets WITH attributes */ + + CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) + CALL check("H5Ldelete_f", error, total_error) + CALL h5ldelete_f(fid, DSET2_NAME, error) + CALL check("H5Ldelete_f", error, total_error) + + ! /* Unlink committed datatype */ + + IF( test_shared == 2) THEN + CALL h5ldelete_f(fid, TYPE1_NAME, error) + CALL check("H5Ldelete_f", error, total_error) + ENDIF + + ! /* Check on attribute storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_ATTR_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ if(test_shared != 0) { +!!$ /* Check on datatype storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_DTYPE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ +!!$ /* Check on dataspace storage status */ +!!$ ret = H5F_get_sohm_mesg_count_test(fid, H5O_SDSPACE_ID, &mesg_count); +!!$ CHECK(ret, FAIL, "H5F_get_sohm_mesg_count_test"); +!!$ VERIFY(mesg_count, 0, "H5F_get_sohm_mesg_count_test"); +!!$ } /* end if */ +!!$ + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) +!!$ +!!$ /* Check size of file */ +!!$ filesize = h5_get_file_size(FILENAME); +!!$ VERIFY(filesize, empty_filesize, "h5_get_file_size"); + ENDDO + + ! /* Close dataspaces */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(big_sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_shared_delete + + + +SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error) + +!/**************************************************************** +!** +!** test_attr_dense_open(): Test basic H5A (attribute) code. +!** Tests opening attributes in "dense" storage +!** +!****************************************************************/ + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(IN) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + + INTEGER :: error + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=2) :: chr2 + + + CHARACTER(LEN=7) :: attrname + + INTEGER(HID_T) :: dataset + INTEGER :: u + + data_dims = 0 + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Opening Attributes in Dense Storage" + + ! /* Create file */ + + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + + ! /* Get size of file */ +!!$ empty_filesize = h5_get_file_size(FILENAME); +!!$ if(empty_filesize < 0) +!!$ TestErrPrintf("Line %d: file size wrong!\n", __LINE__); + + ! /* Re-open file */ + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) + CALL check("h5open_f",error,total_error) + + ! /* Create dataspace for dataset */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Query the group creation properties */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Enable creation order tracking on attributes, so creation order tests work */ + CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_TRACKED_F, error) + CALL check("H5Pset_attr_creation_order",error,total_error) + + ! /* Create a dataset */ + + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, & + lcpl_id=H5P_DEFAULT_F, dcpl_id=dcpl, dapl_id=H5P_DEFAULT_F) + CALL check("h5dcreate_f",error,total_error) + + ! /* Retrieve limits for compact/dense attribute storage */ + CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error) + CALL check("H5Pget_attr_phase_change_f",error,total_error) + + ! /* Close property list */ + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ + ! is_dense = H5O_is_attr_dense_test(dataset); + ! VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Add attributes, until just before converting to dense storage */ + + DO u = 0, max_compact - 1 + ! /* Create attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Write data into the attribute */ + + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Verify attributes written so far */ + CALL test_attr_dense_verify(dataset, u, total_error) +!!$ CHECK(ret, FAIL, "test_attr_dense_verify"); + ENDDO + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + +! /* Add one more attribute, to push into "dense" storage */ +! /* Create attribute */ + + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, TRUE, "H5O_is_attr_dense_test"); + + + ! /* Write data into the attribute */ + data_dims(1) = 1 + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + + ! /* Verify all the attributes written */ + ! ret = test_attr_dense_verify(dataset, (u + 1)); + ! CHECK(ret, FAIL, "test_attr_dense_verify"); + + ! /* CLOSE Dataset */ + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Unlink dataset with attributes */ + CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F) + CALL check("H5Ldelete_f", error, total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + ! /* Check size of file */ + ! filesize = h5_get_file_size(FILENAME); + ! VERIFY(filesize, empty_filesize, "h5_get_file_size") + +END SUBROUTINE test_attr_dense_open + +!/**************************************************************** +!** +!** test_attr_dense_verify(): Test basic H5A (attribute) code. +!** Verify attributes on object +!** +!****************************************************************/ + +SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error) + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: loc_id + INTEGER, INTENT(IN) :: max_attr + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(SIZE_T), PARAMETER :: ATTR_NAME_LEN = 8 ! FIX, why if 7 does not work? + + INTEGER :: u + CHARACTER(LEN=2) :: chr2 + CHARACTER(LEN=ATTR_NAME_LEN) :: attrname + CHARACTER(LEN=ATTR_NAME_LEN) :: check_name + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + INTEGER(HID_T) :: attr !String Attribute identifier + INTEGER :: error + INTEGER :: value + + data_dims = 0 + + + ! /* Retrieve the current # of reported errors */ + ! old_nerrs = GetTestNumErrs(); + + ! /* Re-open all the attributes by name and verify the data */ + + DO u = 0, max_attr -1 + + ! /* Open attribute */ + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL h5aopen_f(loc_id, attrname, attr, error) + CALL check("h5aopen_f",error,total_error) + + ! /* Read data from the attribute */ + +! value = 103 + data_dims(1) = 1 + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error) + + CALL CHECK("H5Aread_F", error, total_error) + CALL VERIFY("H5Aread_F", value, u, total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + ENDDO + + ! /* Re-open all the attributes by index and verify the data */ + + DO u=0, max_attr-1 + +! size_t name_len; /* Length of attribute name */ +! char check_name[ATTR_NAME_LEN]; /* Buffer for checking attribute names */ + + ! /* Open attribute */ + + CALL H5Aopen_by_idx_f(loc_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(u,HSIZE_T), & + attr, error, aapl_id=H5P_DEFAULT_F) + + ! /* Verify Name */ + + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + CALL H5Aget_name_f(attr, ATTR_NAME_LEN, check_name, error) + CALL check('H5Aget_name',error,total_error) + IF(check_name.NE.attrname) THEN + WRITE(*,*) 'ERROR: attribute name different: attr_name = ',check_name, ', should be ', attrname + total_error = total_error + 1 + ENDIF + ! /* Read data from the attribute */ + data_dims(1) = 1 + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error) + CALL CHECK("H5Aread_f", error, total_error) + CALL VERIFY("H5Aread_f", value, u, total_error) + + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + ENDDO + +END SUBROUTINE test_attr_dense_verify + +!/**************************************************************** +!** +!** test_attr_corder_create_empty(): Test basic H5A (attribute) code. +!** Tests basic code to create objects with attribute creation order info +!** +!****************************************************************/ + +SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error ) + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(IN) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: dcpl + INTEGER(HID_T) :: sid + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + + INTEGER(HID_T) :: dataset + + INTEGER :: error + + INTEGER :: crt_order_flags + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Basic Code for Attributes with Creation Order Info" + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Create dataset creation property list */ + CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Get creation order indexing on object */ + CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) + CALL check("H5Pget_attr_creation_order_f",error,total_error) + CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error) + + ! /* Setting invalid combination of a attribute order creation order indexing on should fail */ + CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_INDEXED_F, error) + CALL VERIFY("H5Pset_attr_creation_order_f",error , -1, total_error) + CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) + CALL check("H5Pget_attr_creation_order_f",error,total_error) + CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error) + + ! /* Set attribute creation order tracking & indexing for object */ + CALL h5pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error) + CALL check("H5Pset_attr_creation_order_f",error,total_error) + + CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) + CALL check("H5Pget_attr_creation_order_f",error,total_error) + CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , & + IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error) + + ! /* Create dataspace for dataset */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Create a dataset */ + CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, & + lcpl_id=H5P_DEFAULT_F, dapl_id=H5P_DEFAULT_F, dcpl_id=dcpl) + CALL check("h5dcreate_f",error,total_error) + + ! /* Close dataspace */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_empty = H5O_is_attr_empty_test(dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Close Dataset */ + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close property list */ + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + ! /* Re-open file */ + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) + CALL check("h5open_f",error,total_error) + + ! /* Open dataset created */ + CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F ) + CALL check("h5dopen_f",error,total_error) + + ! /* Check on dataset's attribute storage status */ +!!$ is_empty = H5O_is_attr_empty_test(dataset); +!!$ VERIFY(is_empty, TRUE, "H5O_is_attr_empty_test"); +!!$ is_dense = H5O_is_attr_dense_test(dataset); +!!$ VERIFY(is_dense, FALSE, "H5O_is_attr_dense_test"); + + ! /* Retrieve dataset creation property list for group */ + CALL H5Dget_create_plist_f(dataset, dcpl, error) + CALL check("H5Dget_create_plist_f",error,total_error) + + ! /* Query the attribute creation properties */ + CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error) + CALL check("H5Pget_attr_creation_order_f",error,total_error) + CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , & + IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error ) + + ! /* Close property list */ + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + ! /* Close Dataset */ + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + +END SUBROUTINE test_attr_corder_create_basic + +!/**************************************************************** +!** +!** test_attr_basic_write(): Test basic H5A (attribute) code. +!** Tests integer attributes on both datasets and groups +!** +!****************************************************************/ + +SUBROUTINE test_attr_basic_write(fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid1 + INTEGER(HID_T) :: sid1, sid2 + + CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1" + + INTEGER(HID_T) :: dataset + INTEGER :: i + INTEGER :: error + + INTEGER(HID_T) :: attr,attr2 !String Attribute identifier + INTEGER(HID_T) :: group + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + + CHARACTER(LEN=25) :: check_name + CHARACTER(LEN=18) :: chr_exact_size + + INTEGER, PARAMETER :: SPACE1_RANK = 3 + INTEGER, PARAMETER :: NX = 20 + INTEGER, PARAMETER :: NY = 5 + INTEGER, PARAMETER :: NZ = 10 +! INTEGER(HSIZE_T), DIMENSION(3) :: dims1 = (/NX,NY,NZ/) + + CHARACTER(LEN=5), PARAMETER :: ATTR1_NAME="Attr1" + INTEGER, PARAMETER :: ATTR1_RANK = 1 + INTEGER, PARAMETER :: ATTR1_DIM1 = 3 + CHARACTER(LEN=7), PARAMETER :: ATTR1A_NAME ="Attr1_a" + CHARACTER(LEN=18), PARAMETER :: ATTR_TMP_NAME = "Attr1_a-1234567890" +! int attr_data1a[ATTR1_DIM1]={256,11945,-22107}; + INTEGER, DIMENSION(ATTR1_DIM1), PARAMETER :: attr_data1 =(/258,9987,-99890/) + INTEGER, DIMENSION(ATTR1_DIM1) :: attr_data1a + INTEGER, DIMENSION(ATTR1_DIM1) :: read_data1 + INTEGER(HSIZE_T) :: attr_size ! attributes storage requirements .MSB. +! INTEGER :: attr_data1 + INTEGER(HSIZE_T), DIMENSION(2) :: dims2 = (/4,6/) ! Dataset dimensions + +!!!! start + INTEGER :: rank1 = 2 ! Dataspace1 rank + INTEGER(HSIZE_T), DIMENSION(2) :: dims1 = (/4,6/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(2) :: maxdims1 = (/4,6/) ! maximum dimensions + + INTEGER(SIZE_T) :: size + +! Not setting it as a parameter but intialize caused error +! Look into. -Scot- +! attr_data1(1) = 258 +! attr_data1(2) = 9987 +! attr_data1(3) = -99890 + + attr_data1a(1) = 258 + attr_data1a(2) = 1087 + attr_data1a(3) = -99890 + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Basic Scalar Attribute Writing Functions" + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid1, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Create dataspace for dataset */ + CALL h5screate_simple_f(rank1, dims1, sid1, error, maxdims1) +! CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error) + CALL check("h5screate_simple_f",error,total_error) + + ! /* Create a dataset */ +! sid1 = H5Screate_simple(SPACE1_RANK, dims1, NULL); + CALL h5dcreate_f(fid1, DSET1_NAME, H5T_NATIVE_CHARACTER, sid1, dataset, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F ) + CALL check("h5dcreate_f",error,total_error) + + ! /* Create dataspace for attribute */ + CALL h5screate_simple_f(ATTR1_RANK, dims2, sid2, error) + CALL check("h5screate_simple_f",error,total_error) + + ! /* Try to create an attribute on the file (should create an attribute on root group) */ + CALL h5acreate_f(fid1, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, aapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Open the root group */ + CALL H5Gopen_f(fid1, "/", group, error, H5P_DEFAULT_F) + CALL check("H5Gopen_f",error,total_error) + + ! /* Open attribute again */ + CALL h5aopen_f(group, ATTR1_NAME, attr, error) + CALL check("h5aopen_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Close root group */ + CALL H5Gclose_f(group, error) + CALL check("h5gclose_f",error,total_error) + + ! /* Create an attribute for the dataset */ + CALL h5acreate_f(dataset, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Write attribute information */ + data_dims(1) = 3 + + CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Create an another attribute for the dataset */ + CALL h5acreate_f(dataset, ATTR1A_NAME, H5T_NATIVE_INTEGER, sid2, attr2, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + ! /* Write attribute information */ + CALL h5awrite_f(attr2, H5T_NATIVE_INTEGER, attr_data1a, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + ! /* Check storage size for attribute */ + + CALL h5aget_storage_size_f(attr, attr_size, error) + CALL check("h5aget_storage_size_f",error,total_error) + CALL VERIFY("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error) + +! attr_size = H5Aget_storage_size(attr); +! VERIFY(attr_size, (ATTR1_DIM1 * sizeof(int)), "H5A_get_storage_size"); + + ! /* Read attribute information immediately, without closing attribute */ + CALL h5aread_f(attr, H5T_NATIVE_INTEGER, read_data1, data_dims, error) + CALL check("h5aread_f",error,total_error) + + ! /* Verify values read in */ + DO i = 1, ATTR1_DIM1 + CALL VERIFY('h5aread_f',attr_data1(i),read_data1(i), total_error) + ENDDO + + ! /* CLOSE attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr2, error) + CALL check("h5aclose_f",error,total_error) + + ! /* change attribute name */ + CALL H5Arename_f(dataset, ATTR1_NAME, ATTR_TMP_NAME, error) + CALL check("H5Arename_f", error, total_error) + + ! /* Open attribute again */ + + CALL h5aopen_f(dataset, ATTR_TMP_NAME, attr, error) + CALL check("h5aopen_f",error,total_error) + + ! /* Verify new attribute name */ + ! Set a deliberately small size + + check_name = ' ' ! need to initialize or does not pass test + + size = 1 + CALL H5Aget_name_f(attr, size, check_name, error) + CALL check('H5Aget_name',error,total_error) + + ! Now enter with the corrected size + IF(error.NE.size)THEN + size = error + CALL H5Aget_name_f(attr, size, check_name, error) + CALL check('H5Aget_name',error,total_error) + ENDIF + + IF(TRIM(ADJUSTL(check_name)).NE.TRIM(ADJUSTL(ATTR_TMP_NAME))) THEN + PRINT*,'.'//TRIM(check_name)//'.',LEN_TRIM(check_name) + PRINT*,'.'//TRIM(ATTR_TMP_NAME)//'.',LEN_TRIM(ATTR_TMP_NAME) + WRITE(*,*) 'ERROR: attribute name different: attr_name ='//TRIM(check_name)//'.' + WRITE(*,*) ' should be ='//TRIM(ATTR_TMP_NAME)//'.' + total_error = total_error + 1 + stop + ENDIF + + ! Try with a string buffer that is exactly the correct size + size = 18 + CALL H5Aget_name_f(attr, size, chr_exact_size, error) + CALL check('H5Aget_name_f',error,total_error) + CALL VerifyString('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr, error) + CALL check("h5aclose_f",error,total_error) +!!$ +!!$ /* Open the second attribute again */ +!!$ attr2=H5Aopen(dataset, ATTR1A_NAME, H5P_DEFAULT); +!!$ CHECK(attr, FAIL, "H5Aopen"); +!!$ +!!$ /* Verify new attribute name */ +!!$ attr_name_size = H5Aget_name(attr2, (size_t)0, NULL); +!!$ CHECK(attr_name_size, FAIL, "H5Aget_name"); +!!$ +!!$ if(attr_name_size>0) +!!$ attr_name = (char*)HDcalloc((size_t)(attr_name_size+1), sizeof(char)); +!!$ +!!$ ret=(herr_t)H5Aget_name(attr2, (size_t)(attr_name_size+1), attr_name); +!!$ CHECK(ret, FAIL, "H5Aget_name"); +!!$ ret=HDstrcmp(attr_name, ATTR1A_NAME); +!!$ VERIFY(ret, 0, "HDstrcmp"); +!!$ +!!$ if(attr_name) +!!$ HDfree(attr_name); +!!$ +!!$ /* Read attribute information immediately, without closing attribute */ +!!$ ret=H5Aread(attr2,H5T_NATIVE_INT,read_data1); +!!$ CHECK(ret, FAIL, "H5Aread"); +!!$ +!!$ /* Verify values read in */ +!!$ for(i=0; i<ATTR1_DIM1; i++) +!!$ if(attr_data1a[i]!=read_data1[i]) +!!$ TestErrPrintf("%d: attribute data different: attr_data1a[%d]=%d, read_data1[%d]=%d\n",__LINE__,i,attr_data1a[i],i,read_data1[i]); +!!$ +!!$ /* Close attribute */ +!!$ ret=H5Aclose(attr2); +!!$ CHECK(ret, FAIL, "H5Aclose"); + + CALL h5sclose_f(sid1, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(sid2, error) + CALL check("h5sclose_f",error,total_error) + + !/* Close Dataset */ + CALL h5dclose_f(dataset, error) + CALL check("h5dclose_f",error,total_error) + +!!$ /* Create group */ +!!$ group = H5Gcreate2(fid1, GROUP1_NAME, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +!!$ CHECK(group, FAIL, "H5Gcreate2"); +!!$ +!!$ /* Create dataspace for attribute */ +!!$ sid2 = H5Screate_simple(ATTR2_RANK, dims3, NULL); +!!$ CHECK(sid2, FAIL, "H5Screate_simple"); +!!$ +!!$ /* Create an attribute for the group */ +!!$ attr = H5Acreate2(group, ATTR2_NAME, H5T_NATIVE_INT, sid2, H5P_DEFAULT, H5P_DEFAULT); +!!$ CHECK(attr, FAIL, "H5Acreate2"); +!!$ +!!$ /* Check storage size for attribute */ +!!$ attr_size = H5Aget_storage_size(attr); +!!$ VERIFY(attr_size, (ATTR2_DIM1 * ATTR2_DIM2 * sizeof(int)), "H5Aget_storage_size"); +!!$ +!!$ /* Try to create the same attribute again (should fail) */ +!!$ ret = H5Acreate2(group, ATTR2_NAME, H5T_NATIVE_INT, sid2, H5P_DEFAULT, H5P_DEFAULT); +!!$ VERIFY(ret, FAIL, "H5Acreate2"); +!!$ +!!$ /* Write attribute information */ +!!$ ret = H5Awrite(attr, H5T_NATIVE_INT, attr_data2); +!!$ CHECK(ret, FAIL, "H5Awrite"); +!!$ +!!$ /* Check storage size for attribute */ +!!$ attr_size = H5Aget_storage_size(attr); +!!$ VERIFY(attr_size, (ATTR2_DIM1 * ATTR2_DIM2 * sizeof(int)), "H5A_get_storage_size"); +!!$ +!!$ /* Close attribute */ +!!$ ret = H5Aclose(attr); +!!$ CHECK(ret, FAIL, "H5Aclose"); +!!$ +!!$ /* Close Attribute dataspace */ +!!$ ret = H5Sclose(sid2); +!!$ CHECK(ret, FAIL, "H5Sclose"); + +!!$ !/* Close Group */ +!!$ ret = H5Gclose(group); +!!$ CHECK(ret, FAIL, "H5Gclose"); + + ! /* Close file */ + CALL h5fclose_f(fid1, error) + CALL check("h5fclose_f",error,total_error) + +END SUBROUTINE test_attr_basic_write + +!/**************************************************************** +!** +!** test_attr_many(): Test basic H5A (attribute) code. +!** Tests storing lots of attributes +!** +!****************************************************************/ + +SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: new_format + INTEGER(HID_T), INTENT(IN) :: fcpl + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(IN) :: total_error + CHARACTER(LEN=8) :: FileName = "tattr.h5" + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: sid + INTEGER(HID_T) :: gid + INTEGER(HID_T) :: aid + + + + INTEGER :: error + + INTEGER(HSIZE_T), DIMENSION(7) :: data_dims + CHARACTER(LEN=5) :: chr5 + + + CHARACTER(LEN=11) :: attrname + CHARACTER(LEN=8), PARAMETER :: GROUP1_NAME="/Group1" + + INTEGER :: u + INTEGER :: nattr + LOGICAL :: exists + INTEGER, DIMENSION(1) :: attr_data1 + + data_dims = 0 + + ! /* Output message about test being performed */ + WRITE(*,*) " - Testing Storing Many Attributes" + + !/* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Create dataspace for attribute */ + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f",error,total_error) + + ! /* Create group for attributes */ + + CALL H5Gcreate_f(fid, GROUP1_NAME, gid, error) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Create many attributes */ + + IF(new_format)THEN + nattr = 250 + ELSE + nattr = 2 + ENDIF + + DO u = 0, nattr - 1 + + WRITE(chr5,'(I5.5)') u + attrname = 'attr '//chr5 + CALL H5Aexists_f( gid, attrname, exists, error) + CALL VerifyLogical("H5Aexists",exists,.FALSE.,total_error ) + + CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error, lapl_id = H5P_DEFAULT_F) + CALL VerifyLogical("H5Aexists_by_name_f",exists,.FALSE.,total_error ) + + CALL h5acreate_f(gid, attrname, H5T_NATIVE_INTEGER, sid, aid, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5acreate_f",error,total_error) + + CALL H5Aexists_f(gid, attrname, exists, error) + CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error ) + + CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error ) + + attr_data1(1) = u + data_dims(1) = 1 + + CALL h5awrite_f(aid, H5T_NATIVE_INTEGER, attr_data1, data_dims, error) + CALL check("h5awrite_f",error,total_error) + + CALL h5aclose_f(aid, error) + CALL check("h5aclose_f",error,total_error) + + CALL H5Aexists_f(gid, attrname, exists, error) + CALL VerifyLogical("H5Aexists",exists,.TRUE.,total_error ) + + CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL VerifyLogical("H5Aexists_by_name_f",exists,.TRUE.,total_error ) + + ENDDO + + ! /* Close group */ + CALL H5Gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + + ! /* Close file */ + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + +!!$ /* Re-open the file and check on the attributes */ +!!$ +!!$ /* Re-open file */ +!!$ fid = H5Fopen(FILENAME, H5F_ACC_RDONLY, fapl); +!!$ CHECK(fid, FAIL, "H5Fopen"); +!!$ +!!$ /* Re-open group */ +!!$ gid = H5Gopen2(fid, GROUP1_NAME, H5P_DEFAULT); +!!$ CHECK(gid, FAIL, "H5Gopen2"); +!!$ +!!$ /* Verify attributes */ +!!$ for(u = 0; u < nattr; u++) { +!!$ unsigned value; /* Attribute value */ +!!$ +!!$ sprintf(attrname, "a-%06u", u); +!!$ +!!$ exists = H5Aexists(gid, attrname); +!!$ VERIFY(exists, TRUE, "H5Aexists"); +!!$ +!!$ exists = H5Aexists_by_name(fid, GROUP1_NAME, attrname, H5P_DEFAULT); +!!$ VERIFY(exists, TRUE, "H5Aexists_by_name"); +!!$ +!!$ aid = H5Aopen(gid, attrname, H5P_DEFAULT); +!!$ CHECK(aid, FAIL, "H5Aopen"); +!!$ +!!$ exists = H5Aexists(gid, attrname); +!!$ VERIFY(exists, TRUE, "H5Aexists"); +!!$ +!!$ exists = H5Aexists_by_name(fid, GROUP1_NAME, attrname, H5P_DEFAULT); +!!$ VERIFY(exists, TRUE, "H5Aexists_by_name"); +!!$ +!!$ ret = H5Aread(aid, H5T_NATIVE_UINT, &value); +!!$ CHECK(ret, FAIL, "H5Aread"); +!!$ VERIFY(value, u, "H5Aread"); +!!$ +!!$ ret = H5Aclose(aid); +!!$ CHECK(ret, FAIL, "H5Aclose"); +!!$ } /* end for */ +!!$ + ! /* Close group */ +!!$ CALL H5Gclose_f(gid, error) +!!$ CALL check("h5gclose_f",error,total_error) + + ! /* Close file */ +!!$ CALL h5fclose_f(fid, error) +!!$ CALL check("h5fclose_f",error,total_error) + +! /* Close dataspaces */ + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f",error,total_error) + +END SUBROUTINE test_attr_many + +!/*------------------------------------------------------------------------- +! * Function: attr_open_check +! * +! * Purpose: Check opening attribute on an object +! * +! * Return: Success: 0 +! * Failure: -1 +! * +! * Programmer: Quincey Koziol +! * Wednesday, February 21, 2007 +! * +! *------------------------------------------------------------------------- +! */ + +SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error ) + + USE HDF5 + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fid + CHARACTER(LEN=*), INTENT(IN) :: dsetname + INTEGER(HID_T), INTENT(IN) :: obj_id + INTEGER, INTENT(IN) :: max_attrs + INTEGER, INTENT(INOUT) :: total_error + + INTEGER :: u + CHARACTER (LEN=8) :: attrname + INTEGER, PARAMETER :: NUM_DSETS = 3 + INTEGER :: error + LOGICAL :: f_corder_valid ! Indicates whether the the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! indicates the size, in the number of characters + + CHARACTER(LEN=2) :: chr2 + INTEGER(HID_T) attr_id + ! /* Open each attribute on object by index and check that it's the correct one */ + + DO u = 0, max_attrs-1 + ! /* Open the attribute */ + + WRITE(chr2,'(I2.2)') u + attrname = 'attr '//chr2 + + + CALL h5aopen_f(obj_id, attrname, attr_id, error) + CALL check("h5aopen_f",error,total_error) + + + ! /* Get the attribute's information */ + + CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_f",error,total_error) + ! /* Check that the object is the correct one */ + CALL VERIFY("h5aget_info_f",corder,u,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr_id, error) + CALL check("h5aclose_f",error,total_error) + + ! /* Open the attribute */ + + CALL H5Aopen_by_name_f(obj_id, ".", attrname, attr_id, error, lapl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F) + CALL check("H5Aopen_by_name_f", error, total_error) + + CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_f",error,total_error) + ! /* Get the attribute's information */ + CALL VERIFY("h5aget_info_f",corder,u,total_error) + + + ! /* Close attribute */ + CALL h5aclose_f(attr_id, error) + CALL check("h5aclose_f",error,total_error) + + + ! /* Open the attribute */ + CALL H5Aopen_by_name_f(fid, dsetname, attrname, attr_id, error) + CALL check("H5Aopen_by_name_f", error, total_error) + + + ! /* Get the attribute's information */ + CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error) + CALL check("h5aget_info_f",error,total_error) + + ! /* Check that the object is the correct one */ + CALL VERIFY("h5aget_info_f",corder,u,total_error) + + ! /* Close attribute */ + CALL h5aclose_f(attr_id, error) + CALL check("h5aclose_f",error,total_error) + ENDDO + +END SUBROUTINE attr_open_check diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90 index 77c5fe8..859d66e 100644 --- a/fortran/test/tH5F.f90 +++ b/fortran/test/tH5F.f90 @@ -697,8 +697,6 @@ LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error INTEGER :: error - INTEGER flag - INTEGER :: free_space_out ! CHARACTER(LEN=10), PARAMETER :: filename = "file_space" diff --git a/fortran/test/tH5G.f90 b/fortran/test/tH5G.f90 index 437970f..e0270a9 100644 --- a/fortran/test/tH5G.f90 +++ b/fortran/test/tH5G.f90 @@ -58,7 +58,6 @@ CHARACTER(LEN=100) :: name !name to put symbolic object CHARACTER(LEN=100) :: commentout !comment to the file INTEGER :: nmembers - INTEGER :: obj_type INTEGER(HSIZE_T), DIMENSION(2) :: data_dims ! ! Create the file. @@ -82,7 +81,6 @@ ! CALL h5gcreate_f(file_id, groupname2, group2_id, error) CALL check("h5gcreate_f",error,total_error) - ! !Create data space for the dataset. ! @@ -135,7 +133,6 @@ ! CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname2, linkname4, error) CALL check("h5glink_f",error,total_error) - ! !close group1 ! @@ -165,8 +162,6 @@ write(*,*) "got nmembers ", nmembers, " is wrong" total_error = total_error +1 end if - - ! !Get the name of a symbolic name ! diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90 new file mode 100644 index 0000000..6eee5c2 --- /dev/null +++ b/fortran/test/tH5G_1_8.f90 @@ -0,0 +1,2823 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +SUBROUTINE group_test(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */ + + INTEGER :: error + + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("H5Pcreate_f",error, total_error) + + ! /* Copy the file access property list */ + CALL H5Pcopy_f(fapl, fapl2, error) + CALL check("H5Pcopy_f",error, total_error) + + ! /* Set the "use the latest version of the format" bounds for creating objects in the file */ + CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + + ! /* Check for FAPL to USE */ + my_fapl = fapl2 + + + CALL mklinks(fapl2, total_error) + CALL cklinks(fapl2, total_error) + + CALL group_info(cleanup, fapl2,total_error) +! CALL ud_hard_links(fapl2,total_error) + CALL timestamps(cleanup, fapl2, total_error) + CALL test_move_preserves(fapl2, total_error) + CALL delete_by_idx(cleanup,fapl2, total_error) + CALL test_lcpl(cleanup, fapl, total_error) + + CALL objcopy(fapl, total_error) + + CALL lifecycle(cleanup, fapl2, total_error) + + IF(cleanup) CALL h5_cleanup_f("TestLinks", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + +END SUBROUTINE group_test + +!/*------------------------------------------------------------------------- +! * Function: group_info +! * +! * Purpose: Create a group with creation order indices and test querying +! * group info. +! * +! * Return: Success: 0 +! * Failure: -1 +! * +! * Programmer: Adapted from C test routines by +! * M.S. Breitenfeld +! * February 18, 2008 +! * +! *------------------------------------------------------------------------- +! */ + +SUBROUTINE group_info(cleanup, fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + + INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ + + INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ + INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ + + INTEGER :: idx_type ! /* Type of index to operate on */ + INTEGER :: order, iorder ! /* Order within in the index */ + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! /* Use index on creation order values */ + CHARACTER(LEN=6), PARAMETER :: prefix = 'links0' + CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */ + INTEGER :: Input1 + INTEGER(HID_T) :: group_id ! /* Group ID */ + INTEGER(HID_T) :: soft_group_id ! /* Group ID for soft links */ + + INTEGER :: i ! /* Local index variables */ + INTEGER :: storage_type ! Type of storage for links in group: + ! H5G_STORAGE_TYPE_COMPACT: Compact storage + ! H5G_STORAGE_TYPE_DENSE: Indexed storage + ! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure + INTEGER :: nlinks ! Number of links in group + INTEGER :: max_corder ! Current maximum creation order value for group + + INTEGER :: u,v ! /* Local index variables */ + CHARACTER(LEN=2) :: chr2 + INTEGER(HID_T) :: group_id2, group_id3 ! /* Group IDs */ + CHARACTER(LEN=7) :: objname ! /* Object name */ + CHARACTER(LEN=7) :: objname2 ! /* Object name */ + CHARACTER(LEN=19) :: valname ! /* Link value */ + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" + CHARACTER(LEN=17), PARAMETER :: CORDER_SOFT_GROUP_NAME = "corder_soft_group" + INTEGER(HID_T) :: file_id ! /* File ID */ + INTEGER :: error ! /* Generic return value */ + + LOGICAL :: cleanup + + ! /* Create group creation property list */ + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) + CALL check("H5Pcreate_f", error, total_error) + + ! /* Query the group creation properties */ + CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error) + CALL check("H5Pget_link_phase_change_f", error, total_error) + + ! /* Loop over operating on different indices on link fields */ + DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F + ! /* Loop over operating in different orders */ + DO iorder = H5_ITER_INC_F, H5_ITER_NATIVE_F + ! /* Loop over using index for creation order value */ + DO i = 1, 2 + ! /* Print appropriate test message */ + IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN + IF(iorder == H5_ITER_INC_F)THEN + order = H5_ITER_INC_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index" + ENDIF + ELSE IF (iorder == H5_ITER_DEC_F) THEN + order = H5_ITER_DEC_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index" + ENDIF + ELSE + order = H5_ITER_NATIVE_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index" + ENDIF + ENDIF + ELSE + IF(iorder == H5_ITER_INC_F)THEN + order = H5_ITER_INC_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in increasing order w/o creation order index" + ENDIF + ELSE IF (iorder == H5_ITER_DEC_F) THEN + order = H5_ITER_DEC_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in decreasing order w/o creation order index" + ENDIF + ELSE + order = H5_ITER_NATIVE_F + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"query group info by creation order index in native order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"query group info by creation order index in native order w/o creation order index" + ENDIF + ENDIF + END IF + + ! /* Create file */ + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL check("H5Fcreate_f", error, total_error) + + ! /* Set creation order tracking & indexing on group */ + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) + CALL check("H5Pset_link_creation_order_f", error, total_error) + + ! /* Create group with creation order tracking on */ + CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Create group with creation order tracking on for soft links */ + CALL H5Gcreate_f(file_id, CORDER_SOFT_GROUP_NAME, soft_group_id, error, & + OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Check for out of bound query by index on empty group, should fail */ + CALL H5Gget_info_by_idx_f(group_id, ".", H5_INDEX_NAME_F, order, INT(0,HSIZE_T), & + storage_type, nlinks, max_corder, error) + CALL VERIFY("H5Gget_info_by_idx", error, -1, total_error) + + ! /* Create several links, up to limit of compact form */ + DO u = 0, max_compact-1 + + ! /* Make name for link */ + WRITE(chr2,'(I2.2)') u + objname = 'fill '//chr2 + + ! /* Create hard link, with group object */ + CALL H5Gcreate_f(group_id, objname, group_id2, error, OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Retrieve group's information */ + CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_f", error, total_error) + + ! /* Check (new/empty) group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error) + + ! /* Retrieve group's information */ + CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_name", error, total_error) + + ! /* Check (new/empty) group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error) + + ! /* Retrieve group's information */ + CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_name", error, total_error) + + ! /* Check (new/empty) group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error) + + ! /* Create objects in new group created */ + DO v = 0, u + ! /* Make name for link */ + WRITE(chr2,'(I2.2)') v + objname2 = 'fill '//chr2 + + ! /* Create hard link, with group object */ + CALL H5Gcreate_f(group_id2, objname2, group_id3, error ) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Close group created */ + CALL H5Gclose_f(group_id3, error) + CALL check("H5Gclose_f", error, total_error) + ENDDO + + ! /* Retrieve group's information */ + CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_f", error, total_error) + + ! /* Check (new) group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) + + ! /* Retrieve group's information */ + CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! /* Check (new) group's information */ + CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_by_name_f",max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) + + ! /* Retrieve group's information */ + CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! /* Check (new) group's information */ + CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_by_name_f2", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) + + ! /* Retrieve group's information */ + IF(order.NE.H5_ITER_NATIVE_F)THEN + IF(order.EQ.H5_ITER_INC_F) THEN + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), & + storage_type, nlinks, max_corder, error,lapl_id=H5P_DEFAULT_F) + CALL check("H5Gget_info_by_idx_f", error, total_error) + ELSE + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), & + storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_idx_f", error, total_error) + ENDIF + ! /* Check (new) group's information */ + CALL VERIFY("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_by_idx_f33", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_by_idx_f", nlinks, u+1, total_error) + ENDIF + ! /* Close group created */ + CALL H5Gclose_f(group_id2, error) + CALL check("H5Gclose_f", error, total_error) + + ! /* Retrieve main group's information */ + CALL H5Gget_info_f(group_id, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_f", error, total_error) + + ! /* Check main group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f2", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) + + ! /* Retrieve main group's information, by name */ + CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! /* Check main group's information */ + CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) + + ! /* Retrieve main group's information, by name */ + CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! /* Check main group's information */ + CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error) + + ! /* Create soft link in another group, to objects in main group */ + valname = CORDER_GROUP_NAME//objname + + CALL H5Lcreate_soft_f(valname, soft_group_id, objname, error, H5P_DEFAULT_F, H5P_DEFAULT_F) + + ! /* Retrieve soft link group's information, by name */ + CALL H5Gget_info_f(soft_group_id, storage_type, nlinks, max_corder, error) + CALL check("H5Gget_info_f", error, total_error) + + ! /* Check soft link group's information */ + CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error) + CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error) + ENDDO + + ! /* Verify state of group (compact) */ + ! if(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR + + !/* Check for out of bound query by index */ + ! H5E_BEGIN_TRY { + ! ret = H5Gget_info_by_idx(group_id, ".", H5_INDEX_NAME, order, (hsize_t)u, &grp_info, H5P_DEFAULT); + ! } H5E_END_TRY; + ! if(ret >= 0) TEST_ERROR + + ! /* Create more links, to push group into dense form */ +!!$ for(; u < (max_compact * 2); u++) { +!!$ hid_t group_id2, group_id3; /* Group IDs */ +!!$ +!!$ /* Make name for link */ +!!$ sprintf(objname, "filler %02u", u); +!!$ +!!$ /* Create hard link, with group object */ +!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, gcpl_id, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ +!!$ /* Retrieve group's information */ +!!$ if(H5Gget_info(group_id2, &grp_info) < 0) TEST_ERROR +!!$ +!!$ /* Check (new/empty) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR +!!$ if(grp_info.max_corder != 0) TEST_ERROR +!!$ if(grp_info.nlinks != 0) TEST_ERROR +!!$ +!!$ /* Retrieve group's information, by name */ +!!$ if(H5Gget_info_by_name(group_id, objname, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check (new/empty) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR +!!$ if(grp_info.max_corder != 0) TEST_ERROR +!!$ if(grp_info.nlinks != 0) TEST_ERROR +!!$ +!!$ /* Retrieve group's information, by name */ +!!$ if(H5Gget_info_by_name(group_id2, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check (new/empty) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_COMPACT) TEST_ERROR +!!$ if(grp_info.max_corder != 0) TEST_ERROR +!!$ if(grp_info.nlinks != 0) TEST_ERROR +!!$ +!!$ +!!$ /* Create objects in new group created */ +!!$ for(v = 0; v <= u; v++) { +!!$ /* Make name for link */ +!!$ sprintf(objname2, "filler %02u", v); +!!$ +!!$ /* Create hard link, with group object */ +!!$ if((group_id3 = H5Gcreate2(group_id2, objname2, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Close group created */ +!!$ if(H5Gclose(group_id3) < 0) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ +!!$ /* Retrieve group's information */ +!!$ if(H5Gget_info(group_id2, &grp_info) < 0) TEST_ERROR +!!$ +!!$ /* Check (new) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ /* Retrieve group's information, by name */ +!!$ if(H5Gget_info_by_name(group_id, objname, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check (new) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ /* Retrieve group's information, by name */ +!!$ if(H5Gget_info_by_name(group_id2, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check (new) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ +!!$ /* Retrieve group's information */ +!!$ if(order != H5_ITER_NATIVE) { +!!$ if(order == H5_ITER_INC) { +!!$ if(H5Gget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)u, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ } /* end if */ +!!$ else { +!!$ if(H5Gget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ } /* end else */ +!!$ +!!$ /* Check (new) group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Close group created */ +!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR +!!$ +!!$ +!!$ /* Retrieve main group's information */ +!!$ if(H5Gget_info(group_id, &grp_info) < 0) TEST_ERROR +!!$ +!!$ /* Check main group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ /* Retrieve main group's information, by name */ +!!$ if(H5Gget_info_by_name(file_id, CORDER_GROUP_NAME, &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check main group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ /* Retrieve main group's information, by name */ +!!$ if(H5Gget_info_by_name(group_id, ".", &grp_info, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Check main group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ +!!$ +!!$ /* Create soft link in another group, to objects in main group */ +!!$ sprintf(valname, "/%s/%s", CORDER_GROUP_NAME, objname); +!!$ if(H5Lcreate_soft(valname, soft_group_id, objname, H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Retrieve soft link group's information, by name */ +!!$ if(H5Gget_info(soft_group_id, &grp_info) < 0) TEST_ERROR +!!$ +!!$ /* Check soft link group's information */ +!!$ if(grp_info.storage_type != H5G_STORAGE_TYPE_DENSE) TEST_ERROR +!!$ if(grp_info.max_corder != (int64_t)(u + 1)) TEST_ERROR +!!$ if(grp_info.nlinks != (hsize_t)(u + 1)) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Verify state of group (dense) */ +!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR +!!$ +!!$ /* Check for out of bound query by index */ +!!$ H5E_BEGIN_TRY { +!!$ ret = H5Gget_info_by_idx(group_id, ".", H5_INDEX_NAME, order, (hsize_t)u, &grp_info, H5P_DEFAULT); +!!$ } H5E_END_TRY; +!!$ if(ret >= 0) TEST_ERROR + + + ! /* Close the groups */ + + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(soft_group_id, error) + CALL check("H5Gclose_f", error, total_error) + + ! /* Close the file */ + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + ENDDO + ENDDO + ENDDO + + ! /* Free resources */ + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + + END SUBROUTINE group_info + +!/*------------------------------------------------------------------------- +! * Function: timestamps +! * +! * Purpose: Verify that disabling tracking timestamps for an object +! * works correctly +! * +! * +! * Programmer: M.S. Breitenfeld +! * February 20, 2008 +! * +! *------------------------------------------------------------------------- +! */ + + SUBROUTINE timestamps(cleanup, fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + + INTEGER(HID_T) :: file_id !/* File ID */ + INTEGER(HID_T) :: group_id !/* Group ID */ + INTEGER(HID_T) :: group_id2 !/* Group ID */ + INTEGER(HID_T) :: gcpl_id !/* Group creation property list ID */ + INTEGER(HID_T) :: gcpl_id2 !/* Group creation property list ID */ + + CHARACTER(LEN=6), PARAMETER :: prefix = 'links9' + CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */ + ! /* Timestamp macros */ + CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_1="timestamp1" + CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_2="timestamp2" + LOGICAL :: track_times + LOGICAL :: cleanup + + INTEGER :: error + + ! /* Print test message */ + WRITE(*,*) "timestamps on objects" + + ! /* Create group creation property list */ + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) + CALL check("H5Pcreate_f", error, total_error) + + ! /* Query the object timestamp setting */ + CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + + !/* Check default timestamp information */ + CALL VerifyLogical("H5Pget_obj_track_times",track_times,.TRUE.,total_error) + + ! /* Set a non-default object timestamp setting */ + CALL H5Pset_obj_track_times_f(gcpl_id, .FALSE., error) + CALL check("H5Pset_obj_track_times_f", error, total_error) + + ! /* Query the object timestamp setting */ + CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + + ! /* Check default timestamp information */ + CALL VerifyLogical("H5Pget_obj_track_times",track_times,.FALSE.,total_error) + + ! /* Create file */ + !h5_fixname(FILENAME[0], fapl, filename, sizeof filename); + + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f",error,total_error) + + ! /* Create group with non-default object timestamp setting */ + CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_1, group_id, error, & + OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id, H5P_DEFAULT_F) + CALL check("h5fcreate_f",error,total_error) + + ! /* Close the group creation property list */ + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + + ! /* Create group with default object timestamp setting */ + CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, & + OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F) + CALL check("h5fcreate_f",error,total_error) + + ! /* Retrieve the new groups' creation properties */ + CALL H5Gget_create_plist_f(group_id, gcpl_id, error) + CALL check("H5Gget_create_plist", error, total_error) + CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error) + CALL check("H5Gget_create_plist", error, total_error) + + ! /* Query & verify the object timestamp settings */ + CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error) + CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error) + +! /* Query the object information for each group */ +! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR +! if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR + +!!$ /* Sanity check object information for each group */ +!!$ if(oinfo.atime != 0) TEST_ERROR +!!$ if(oinfo.mtime != 0) TEST_ERROR +!!$ if(oinfo.ctime != 0) TEST_ERROR +!!$ if(oinfo.btime != 0) TEST_ERROR +!!$ if(oinfo.atime == oinfo2.atime) TEST_ERROR +!!$ if(oinfo.mtime == oinfo2.mtime) TEST_ERROR +!!$ if(oinfo.ctime == oinfo2.ctime) TEST_ERROR +!!$ if(oinfo.btime == oinfo2.btime) TEST_ERROR +!!$ if((oinfo.hdr.flags & H5O_HDR_STORE_TIMES) != 0) TEST_ERROR +!!$ if((oinfo2.hdr.flags & H5O_HDR_STORE_TIMES) == 0) TEST_ERROR +!!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR +!!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR + + ! /* Close the property lists */ + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(gcpl_id2, error) + CALL check("H5Pclose_f", error, total_error) + + ! /* Close the groups */ + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(group_id2, error) + CALL check("H5Gclose_f", error, total_error) + + !/* Close the file */ + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + + !/* Re-open the file */ + + CALL h5fopen_f(FileName, H5F_ACC_RDONLY_F, file_id, error, H5P_DEFAULT_F) + CALL check("h5fopen_f",error,total_error) + + !/* Open groups */ + CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_1, group_id, error) ! with no optional param. + CALL check("H5Gopen_f", error, total_error) + CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, H5P_DEFAULT_F) ! with optional param. + CALL check("H5Gopen_f", error, total_error) + + ! /* Retrieve the new groups' creation properties */ + CALL H5Gget_create_plist_f(group_id, gcpl_id, error) + CALL check("H5Gget_create_plist", error, total_error) + CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error) + CALL check("H5Gget_create_plist", error, total_error) + + ! /* Query & verify the object timestamp settings */ + + CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error) + CALL H5Pget_obj_track_times_f(gcpl_id2, track_times, error) + CALL check("H5Pget_obj_track_times_f", error, total_error) + CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error) +!!$ +!!$ /* Query the object information for each group */ +!!$ if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR +!!$ if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR +!!$ +!!$ /* Sanity check object information for each group */ +!!$ if(oinfo.atime != 0) TEST_ERROR +!!$ if(oinfo.mtime != 0) TEST_ERROR +!!$ if(oinfo.ctime != 0) TEST_ERROR +!!$ if(oinfo.btime != 0) TEST_ERROR +!!$ if(oinfo.atime == oinfo2.atime) TEST_ERROR +!!$ if(oinfo.mtime == oinfo2.mtime) TEST_ERROR +!!$ if(oinfo.ctime == oinfo2.ctime) TEST_ERROR +!!$ if(oinfo.btime == oinfo2.btime) TEST_ERROR +!!$ if((oinfo.hdr.flags & H5O_HDR_STORE_TIMES) != 0) TEST_ERROR +!!$ if((oinfo2.hdr.flags & H5O_HDR_STORE_TIMES) == 0) TEST_ERROR +!!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR +!!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR + + ! /* Close the property lists */ + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(gcpl_id2, error) + CALL check("H5Pclose_f", error, total_error) + + ! /* Close the groups */ + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(group_id2, error) + CALL check("H5Gclose_f", error, total_error) + + !/* Close the file */ + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + + END SUBROUTINE timestamps + +!/*------------------------------------------------------------------------- +! * Function: mklinks +! * +! * Purpose: Build a file with assorted links. +! * +! * +! * Programmer: Adapted from C test by: +! * M.S. Breitenfeld +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + + SUBROUTINE mklinks(fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + + INTEGER(HID_T) :: file, scalar, grp, d1 + CHARACTER(LEN=12), PARAMETER :: filename ='TestLinks.h5' + INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension + INTEGER :: arank = 1 ! Attribure rank + INTEGER :: error + + WRITE(*,*) "link creation (w/new group format)" + + ! /* Create a file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file, error, H5P_DEFAULT_F, fapl) + CALL check("mklinks.h5fcreate_f",error,total_error) + CALL h5screate_simple_f(arank, adims2, scalar, error) + CALL check("mklinks.h5screate_simple_f",error,total_error) + + !/* Create a group */ + CALL H5Gcreate_f(file, "grp1", grp, error) + CALL check("H5Gcreate_f", error, total_error) + CALL H5Gclose_f(grp, error) + CALL check("h5gclose_f",error,total_error) + + !/* Create a dataset */ + CALL h5dcreate_f(file, "d1", H5T_NATIVE_INTEGER, scalar, d1, error) + CALL check("h5dcreate_f",error,total_error) + CALL h5dclose_f(d1, error) + CALL check("h5dclose_f",error,total_error) + + !/* Create a hard link */ + CALL H5Lcreate_hard_f(file, "d1", INT(H5L_SAME_LOC_F,HID_T), "grp1/hard", error) + CALL check("H5Lcreate_hard_f", error, total_error) + + !/* Create a symbolic link */ + CALL H5Lcreate_soft_f("/d1", file, "grp1/soft",error) + CALL check("H5Lcreate_soft_f", error, total_error) + + !/* Create a symbolic link to something that doesn't exist */ + + CALL H5Lcreate_soft_f("foobar", file, "grp1/dangle",error) + + !/* Create a recursive symbolic link */ + CALL H5Lcreate_soft_f("/grp1/recursive", file, "/grp1/recursive",error) + + !/* Close */ + CALL h5sclose_f(scalar, error) + CALL check("h5sclose_f",error,total_error) + CALL h5fclose_f(file, error) + CALL check("h5fclose_f",error,total_error) + + END SUBROUTINE mklinks + +!/*------------------------------------------------------------------------- +! * Function: test_move_preserves +! * +! * Purpose: Tests that moving and renaming links preserves their +! * properties. +! * +! * Programmer: M.S. Breitenfeld +! * March 3, 2008 +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + + SUBROUTINE test_move_preserves(fapl_id, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl_id + + INTEGER(HID_T):: file_id + INTEGER(HID_T):: group_id + INTEGER(HID_T):: fcpl_id ! /* Group creation property list ID */ + INTEGER(HID_T):: lcpl_id + INTEGER(HID_T):: lcpl2_id + !H5O_info_t oinfo; + !H5L_info_t linfo; + INTEGER :: old_cset + INTEGER :: old_corder + !H5T_cset_t old_cset; + !int64_t old_corder; /* Creation order value of link */ + !time_t old_modification_time; + !time_t curr_time; + !unsigned crt_order_flags; /* Status of creation order info for GCPL */ + !char filename[1024]; + + INTEGER :: crt_order_flags ! /* Status of creation order info for GCPL */ + CHARACTER(LEN=12), PARAMETER :: filename = 'TestLinks.h5' + + INTEGER :: cset ! Indicates the character set used for the link’s name. + INTEGER :: corder ! Specifies the link’s creation order position. + LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. + INTEGER :: link_type ! Specifies the link class: + ! H5L_LINK_HARD_F - Hard link + ! H5L_LINK_SOFT_F - Soft link + ! H5L_LINK_EXTERNAL_F - External link + ! H5L_LINK_ERROR _F - Error + INTEGER :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(HSIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + + INTEGER :: error + + WRITE(*,*) "moving and copying links preserves their properties (w/new group format)" + + !/* Create a file creation property list with creation order stored for links + ! * in the root group + ! */ + + CALL H5Pcreate_f(H5P_FILE_CREATE_F, fcpl_id, error) + CALL check("H5Pcreate_f",error, total_error) + + CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error) + CALL check("H5Pget_link_creation_order_f",error, total_error) + CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags,0, total_error) + + CALL H5Pset_link_creation_order_f(fcpl_id, H5P_CRT_ORDER_TRACKED_F, error) + CALL check("H5Pset_link_creation_order_f", error, total_error) + + CALL H5Pget_link_creation_order_f(fcpl_id, crt_order_flags, error) + CALL check("H5Pget_link_creation_order_f",error, total_error) + CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error) + + !/* Create file */ + !/* (with creation order tracking for the root group) */ + + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file_id, error, fcpl_id, fapl_id) + CALL check("h5fcreate_f",error,total_error) + + !/* Create a link creation property list with the UTF-8 character encoding */ + CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error) + CALL check("H5Pcreate_f",error, total_error) + + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) + CALL check("H5Pset_char_encoding_f",error, total_error) + + !/* Create a group with that lcpl */ + CALL H5Gcreate_f(file_id, "group", group_id, error,lcpl_id=lcpl_id, gcpl_id=H5P_DEFAULT_F, gapl_id=H5P_DEFAULT_F) + CALL check("H5Gcreate_f", error, total_error) + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + + ! /* Get the group's link's information */ + CALL H5Lget_info_f(file_id, "group", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error, H5P_DEFAULT_F) + CALL check("H5Lget_info_f",error,total_error) + +! if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR + + old_cset = cset + CALL VERIFY("H5Lget_info_f",old_cset,H5T_CSET_UTF8_F,total_error) + CALL VerifyLogical("H5Lget_info_f",f_corder_valid,.TRUE.,total_error) + old_corder = corder; + CALL VERIFY("H5Lget_info_f",old_corder,0,total_error) + +! old_modification_time = oinfo.mtime; + +! /* If this test happens too quickly, the times will all be the same. Make sure the time changes. */ +! curr_time = HDtime(NULL); +! while(HDtime(NULL) <= curr_time) +! ; + +! /* Close the file and reopen it */ + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) + +!!$ if((file_id = H5Fopen(filename, H5F_ACC_RDWR, fapl_id)) < 0) TEST_ERROR +!!$ +!!$ /* Get the link's character set & modification time . They should be unchanged */ +!!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(old_cset != linfo.cset) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(old_corder != linfo.corder) TEST_ERROR +!!$ +!!$ /* Create a new link to the group. It should have a different creation order value but the same modification time */ +!!$ if(H5Lcreate_hard(file_id, "group", file_id, "group2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group2", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_corder == linfo.corder) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(linfo.corder != 1) TEST_ERROR +!!$ if(linfo.cset != H5T_CSET_ASCII) TEST_ERROR +!!$ +!!$ /* Copy the first link to a UTF-8 name. +!!$ * Its creation order value should be different, but modification time +!!$ * should not change. +!!$ */ +!!$ if(H5Lcopy(file_id, "group", file_id, "group_copied", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group_copied", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group_copied", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(linfo.corder != 2) TEST_ERROR +!!$ +!!$ /* Check that its character encoding is UTF-8 */ +!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR +!!$ +!!$ /* Move the link with the default property list. */ +!!$ if(H5Lmove(file_id, "group_copied", file_id, "group_copied2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group_copied2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group_copied2", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(linfo.corder != 3) TEST_ERROR +!!$ +!!$ /* Check that its character encoding is not UTF-8 */ +!!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR +!!$ +!!$ /* Check that the original link is unchanged */ +!!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(old_corder != linfo.corder) TEST_ERROR +!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR +!!$ +!!$ /* Move the first link to a UTF-8 name. +!!$ * Its creation order value will change, but modification time should not +!!$ * change. */ +!!$ if(H5Lmove(file_id, "group", file_id, "group_moved", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group_moved", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group_moved", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(linfo.corder != 4) TEST_ERROR +!!$ +!!$ /* Check that its character encoding is UTF-8 */ +!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR +!!$ +!!$ /* Move the link again using the default property list. */ +!!$ if(H5Lmove(file_id, "group_moved", file_id, "group_moved_again", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(H5Oget_info_by_name(file_id, "group_moved_again", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR +!!$ if(H5Lget_info(file_id, "group_moved_again", &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder_valid != TRUE) TEST_ERROR +!!$ if(linfo.corder != 5) TEST_ERROR +!!$ +!!$ /* Check that its character encoding is not UTF-8 */ +!!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR + + ! /* Close open IDs */ + CALL H5Pclose_f(fcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + CALL H5Pclose_f(lcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + + ! if(H5Fclose(file_id) < 0) TEST_ERROR + + END SUBROUTINE test_move_preserves + +!!$!/*------------------------------------------------------------------------- +!!$! * Function: ud_hard_links +!!$! * +!!$! * Purpose: Check that the functionality of hard links can be duplicated +!!$! * with user-defined links. +!!$! * +!!$! * +!!$! * Programmer: M.S. Breitenfeld +!!$! * February, 2008 +!!$! * +!!$! *------------------------------------------------------------------------- +!!$! */ +!!$! +!!$!/* Callback functions for UD hard links. */ +!!$!/* UD_hard_create increments the object's reference count */ +!!$ +!!$ SUBROUTINE ud_hard_links(fapl, total_error) +!!$ +!!$ USE HDF5 ! This module contains all necessary modules +!!$ +!!$ IMPLICIT NONE +!!$ INTEGER, INTENT(OUT) :: total_error +!!$ INTEGER(HID_T), INTENT(IN) :: fapl +!!$ +!!$ INTEGER(HID_T) :: fid ! /* File ID */ +!!$ INTEGER(HID_T) :: gid ! /* Group IDs */ +!!$ +!!$ CHARACTER(LEN=10) :: objname = 'objname.h5' ! /* Object name */ +!!$ CHARACTER(LEN=10), PARAMETER :: filename = 'filname.h5' +!!$ +!!$ INTEGER(HSIZE_T) :: name_len ! /* Size of an empty file */ +!!$ +!!$ INTEGER, PARAMETER :: UD_HARD_TYPE=201 +!!$ LOGICAL :: registered +!!$ +!!$!/* Link information */ +!!$ +!!$! ssize_t name_len; /* Length of object name */ +!!$! h5_stat_size_t empty_size; /* Size of an empty file */ +!!$ +!!$ +!!$ WRITE(*,*) "user-defined hard link (w/new group format)" +!!$ +!!$ ! /* Set up filename and create file*/ +!!$ +!!$ CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) +!!$ CALL check("h5fcreate_f",error,total_error) +!!$ +!!$ ! /* Close file */ +!!$ CALL h5fclose_f(fid, error) +!!$ CALL check("h5fclose_f",error,total_error) +!!$ +!!$ ! if((empty_size = h5_get_file_size(filename))<0) TEST_ERROR +!!$ +!!$ ! /* Create file */ +!!$ CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) +!!$ CALL check("h5fcreate_f",error,total_error) +!!$ +!!$ ! /* Check that external links are registered and UD hard links are not */ +!!$ +!!$ CALL H5Lis_registered(H5L_TYPE_EXTERNAL, registered, error) +!!$ CALL VerifyLogical("H5Lis_registered", registered, .TRUE., total_error) +!!$ +!!$ CALL H5Lis_registered(UD_HARD_TYPE, registered, error) +!!$ CALL VerifyLogical("H5Lis_registered", registered, .FALSE., total_error) +!!$ +!!$ !/* Register "user-defined hard links" with the library */ +!!$! if(H5Lregister(UD_hard_class) < 0) TEST_ERROR +!!$ +!!$ /* Check that UD hard links are now registered */ +!!$ if(H5Lis_registered(H5L_TYPE_EXTERNAL) != TRUE) TEST_ERROR +!!$ if(H5Lis_registered(UD_HARD_TYPE) != TRUE) TEST_ERROR +!!$ +!!$ /* Create a group for the UD hard link to point to */ +!!$ if((gid = H5Gcreate2(fid, "group", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Get address for the group to give to the hard link */ +!!$ if(H5Lget_info(fid, "group", &li, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ if(H5Gclose(gid) < 0) TEST_ERROR +!!$ +!!$ +!!$ /* Create a user-defined "hard link" to the group using the address we got +!!$ * from H5Lget_info */ +!!$ if(H5Lcreate_ud(fid, "ud_link", UD_HARD_TYPE, &(li.u.address), sizeof(haddr_t), H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Close and re-open file to ensure that data is written to disk */ +!!$ if(H5Fclose(fid) < 0) TEST_ERROR +!!$ if((fid = H5Fopen(filename, H5F_ACC_RDWR, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Open group through UD link */ +!!$ if((gid = H5Gopen2(fid, "ud_link", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Check name */ +!!$ if((name_len = H5Iget_name( gid, objname, (size_t)NAME_BUF_SIZE )) < 0) TEST_ERROR +!!$ if(HDstrcmp(objname, "/group")) TEST_ERROR +!!$ +!!$ /* Create object in group */ +!!$ if((gid2 = H5Gcreate2(gid, "new_group", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Close groups*/ +!!$ if(H5Gclose(gid2) < 0) TEST_ERROR +!!$ if(H5Gclose(gid) < 0) TEST_ERROR +!!$ +!!$ /* Re-open group without using ud link to check that it was created properly */ +!!$ if((gid = H5Gopen2(fid, "group/new_group", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Check name */ +!!$ if((name_len = H5Iget_name( gid, objname, (size_t)NAME_BUF_SIZE )) < 0) TEST_ERROR +!!$ if(HDstrcmp(objname, "/group/new_group")) TEST_ERROR +!!$ +!!$ /* Close opened object */ +!!$ if(H5Gclose(gid) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Check that H5Lget_objinfo works on the hard link */ +!!$ if(H5Lget_info(fid, "ud_link", &li, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ /* UD hard links have no query function, thus return a "link length" of 0 */ +!!$ if(li.u.val_size != 0) TEST_ERROR +!!$ if(UD_HARD_TYPE != li.type) { +!!$ H5_FAILED(); +!!$ puts(" Unexpected link class - should have been a UD hard link"); +!!$ goto error; +!!$ } /* end if */ +!!$ +!!$ /* Unlink the group pointed to by the UD link. It shouldn't be +!!$ * deleted because of the UD link. */ +!!$ if(H5Ldelete(fid, "/group", H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Ensure we can open the group through the UD link */ +!!$ if((gid = H5Gopen2(fid, "ud_link", H5P_DEFAULT)) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Unlink the group contained within it. */ +!!$ if(H5Ldelete(gid, "new_group", H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ if(H5Gclose(gid) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Now delete the UD link. This should cause the group to be +!!$ * deleted, too. */ +!!$ if(H5Ldelete(fid, "ud_link", H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Close file */ +!!$ if(H5Fclose(fid) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* The file should be empty again. */ +!!$ if(empty_size != h5_get_file_size(filename)) TEST_ERROR +!!$ +!!$ if(H5Lunregister(UD_HARD_TYPE) < 0) FAIL_STACK_ERROR +!!$ +!!$ PASSED(); +!!$ return 0; +!!$ +!!$ error: +!!$ H5E_BEGIN_TRY { +!!$ H5Gclose(gid2); +!!$ H5Gclose(gid); +!!$ H5Fclose(fid); +!!$ } H5E_END_TRY; +!!$ return -1; +!!$} /* end ud_hard_links() */ + +!/*------------------------------------------------------------------------- +! * Function: lifecycle +! * +! * Purpose: Test that adding links to a group follow proper "lifecycle" +! * of empty->compact->symbol table->compact->empty. (As group +! * is created, links are added, then links removed) +! * +! * Return: Success: 0 +! * +! * Failure: -1 +! * +! * Programmer: Quincey Koziol +! * Monday, October 17, 2005 +! * +! *------------------------------------------------------------------------- +! */ +SUBROUTINE lifecycle(cleanup, fapl2, total_error) + + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl2 + INTEGER :: error + + INTEGER, PARAMETER :: NAME_BUF_SIZE =7 + + INTEGER(HID_T) :: fid !/* File ID */ + INTEGER(HID_T) :: gid !/* Group ID */ + INTEGER(HID_T) :: gid2 !/* Datatype ID */ + INTEGER(HID_T) :: gcpl !/* Group creation property list ID */ + INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */ + INTEGER :: max_compact !/* Maximum # of links to store in group compactly */ + INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */ + INTEGER :: est_num_entries !/* Estimated # of entries in group */ + INTEGER :: est_name_len !/* Estimated length of entry name */ + INTEGER :: nmsgs !/* Number of messages in group's header */ + CHARACTER(LEN=NAME_BUF_SIZE) :: objname ! /* Object name */ + CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5' + INTEGER :: empty_size ! /* Size of an empty file */ + INTEGER :: u ! /* Local index variable */ + INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256 + INTEGER :: LIFECYCLE_MAX_COMPACT = 4 + INTEGER :: LIFECYCLE_MIN_DENSE = 3 + INTEGER :: LIFECYCLE_EST_NUM_ENTRIES = 4 + INTEGER :: LIFECYCLE_EST_NAME_LEN=8 + CHARACTER(LEN=3) :: LIFECYCLE_TOP_GROUP="top" +! These value are taken from H5Gprivate.h + INTEGER :: H5G_CRT_GINFO_MAX_COMPACT = 8 + INTEGER :: H5G_CRT_GINFO_MIN_DENSE = 6 + INTEGER :: H5G_CRT_GINFO_EST_NUM_ENTRIES = 4 + INTEGER :: H5G_CRT_GINFO_EST_NAME_LEN = 8 + logical :: cleanup + + WRITE(*,*) 'group lifecycle' + + ! /* Create file */ + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl2) + CALL check("H5Fcreate_f",error,total_error) + + !/* Close file */ + CALL H5Fclose_f(fid,error) + CALL check("H5Fclose_f",error,total_error) + + ! /* Get size of file as empty */ + ! if((empty_size = h5_get_file_size(filename)) < 0) TEST_ERROR + + ! /* Re-open file */ + + CALL H5Fopen_f(filename, H5F_ACC_RDWR_F, fid, error,access_prp=fapl2) + CALL check("H5Fopen_f",error,total_error) + + + ! /* Set up group creation property list */ + CALL H5Pcreate_f(H5P_GROUP_CREATE_F,gcpl,error) + CALL check("H5Pcreate_f",error,total_error) + + + ! /* Query default group creation property settings */ + CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error) + CALL check("H5Pget_local_heap_size_hint_f",error,total_error) + CALL verify("H5Pget_local_heap_size_hint_f", lheap_size_hint,0,total_error) + + CALL H5Pget_link_phase_change_f(gcpl, max_compact, min_dense, error) + CALL check("H5Pget_link_phase_change_f", error, total_error) + CALL verify("H5Pget_link_phase_change_f", max_compact, H5G_CRT_GINFO_MAX_COMPACT,total_error) + CALL verify("H5Pget_link_phase_change_f", min_dense, H5G_CRT_GINFO_MIN_DENSE,total_error) + + + CALL H5Pget_est_link_info_f(gcpl, est_num_entries, est_name_len, error) + CALL check("H5Pget_est_link_info_f", error, total_error) + CALL verify("H5Pget_est_link_info_f", est_num_entries, H5G_CRT_GINFO_EST_NUM_ENTRIES,total_error) + CALL verify("H5Pget_est_link_info_f", est_name_len, H5G_CRT_GINFO_EST_NAME_LEN,total_error) + + + !/* Set GCPL parameters */ + + CALL H5Pset_local_heap_size_hint_f(gcpl, LIFECYCLE_LOCAL_HEAP_SIZE_HINT, error) + CALL check("H5Pset_local_heap_size_hint_f", error, total_error) + CALL H5Pset_link_phase_change_f(gcpl, LIFECYCLE_MAX_COMPACT, LIFECYCLE_MIN_DENSE, error) + CALL check("H5Pset_link_phase_change_f", error, total_error) + CALL H5Pset_est_link_info_f(gcpl, LIFECYCLE_EST_NUM_ENTRIES, LIFECYCLE_EST_NAME_LEN, error) + CALL check("H5Pset_est_link_info_f", error, total_error) + + ! /* Create group for testing lifecycle */ + + CALL H5Gcreate_f(fid, LIFECYCLE_TOP_GROUP, gid, error, gcpl_id=gcpl) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Query group creation property settings */ + + CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error) + CALL check("H5Pget_local_heap_size_hint_f",error,total_error) + CALL verify("H5Pget_local_heap_size_hint_f", lheap_size_hint,LIFECYCLE_LOCAL_HEAP_SIZE_HINT,total_error) + + CALL H5Pget_link_phase_change_f(gcpl, max_compact, min_dense, error) + CALL check("H5Pget_link_phase_change_f", error, total_error) + CALL verify("H5Pget_link_phase_change_f", max_compact, LIFECYCLE_MAX_COMPACT,total_error) + CALL verify("H5Pget_link_phase_change_f", min_dense, LIFECYCLE_MIN_DENSE,total_error) + + CALL H5Pget_est_link_info_f(gcpl, est_num_entries, est_name_len, error) + CALL check("H5Pget_est_link_info_f", error, total_error) + CALL verify("H5Pget_est_link_info_f", est_num_entries, LIFECYCLE_EST_NUM_ENTRIES,total_error) + CALL verify("H5Pget_est_link_info_f", est_name_len, LIFECYCLE_EST_NAME_LEN,total_error) + + + ! /* Use internal testing routine to check that the group has no links or symbol table */ + ! if(H5G_is_empty_test(gid) != TRUE) TEST_ERROR + +!!$ /* Create first "bottom" group */ +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, (unsigned)0); +!!$ IF((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Check on bottom group's status */ +!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR +!!$ +!!$ /* Close bottom group */ +!!$ if(H5Gclose(gid2) < 0) TEST_ERROR +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR +!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR +!!$ if(nmsgs != 1) TEST_ERROR +!!$ +!!$ /* Create several more bottom groups, to push the top group almost to a symbol table */ +!!$ /* (Start counting at '1', since we've already created one bottom group */ +!!$ for(u = 1; u < LIFECYCLE_MAX_COMPACT; u++) { +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ if((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Check on bottom group's status */ +!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR +!!$ +!!$ /* Close bottom group */ +!!$ if(H5Gclose(gid2) < 0) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR +!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR +!!$ if(nmsgs != LIFECYCLE_MAX_COMPACT) TEST_ERROR +!!$ if(H5G_is_new_dense_test(gid) != FALSE) TEST_ERROR +!!$ +!!$ /* Check that the object header is only one chunk and the space has been allocated correctly */ +!!$ if(H5Oget_info(gid, &oinfo) < 0) TEST_ERROR +!!$ if(oinfo.hdr.space.total != 151) TEST_ERROR +!!$ if(oinfo.hdr.space.free != 0) TEST_ERROR +!!$ if(oinfo.hdr.nmesgs != 6) TEST_ERROR +!!$ if(oinfo.hdr.nchunks != 1) TEST_ERROR +!!$ +!!$ /* Create one more "bottom" group, which should push top group into using a symbol table */ +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ if((gid2 = H5Gcreate2(gid, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ +!!$ /* Check on bottom group's status */ +!!$ if(H5G_is_empty_test(gid2) != TRUE) TEST_ERROR +!!$ +!!$ /* Close bottom group */ +!!$ if(H5Gclose(gid2) < 0) TEST_ERROR +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR +!!$ if(H5G_has_links_test(gid, NULL) == TRUE) TEST_ERROR +!!$ if(H5G_is_new_dense_test(gid) != TRUE) TEST_ERROR +!!$ +!!$ /* Check that the object header is still one chunk and the space has been allocated correctly */ +!!$ if(H5Oget_info(gid, &oinfo) < 0) TEST_ERROR +!!$ if(oinfo.hdr.space.total != 151) TEST_ERROR +!!$ if(oinfo.hdr.space.free != 92) TEST_ERROR +!!$ if(oinfo.hdr.nmesgs != 3) TEST_ERROR +!!$ if(oinfo.hdr.nchunks != 1) TEST_ERROR +!!$ +!!$ /* Unlink objects from top group */ +!!$ while(u >= LIFECYCLE_MIN_DENSE) { +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ +!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ +!!$ u--; +!!$ } /* end while */ +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR +!!$ if(H5G_has_links_test(gid, NULL) == TRUE) TEST_ERROR +!!$ if(H5G_is_new_dense_test(gid) != TRUE) TEST_ERROR +!!$ +!!$ /* Unlink one more object from the group, which should transform back to using links */ +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ u--; +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) == TRUE) TEST_ERROR +!!$ if(H5G_has_links_test(gid, &nmsgs) != TRUE) TEST_ERROR +!!$ if(nmsgs != (LIFECYCLE_MIN_DENSE - 1)) TEST_ERROR +!!$ +!!$ /* Unlink last two objects from top group */ +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ u--; +!!$ sprintf(objname, LIFECYCLE_BOTTOM_GROUP, u); +!!$ if(H5Ldelete(gid, objname, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ +!!$ /* Check on top group's status */ +!!$ if(H5G_is_empty_test(gid) != TRUE) TEST_ERROR + + !/* Close top group */ + CALL H5Gclose_f(gid, error) + CALL check("H5Gclose_f", error, total_error) + + !/* Unlink top group */ + + CALL H5Ldelete_f(fid, LIFECYCLE_TOP_GROUP, error) + CALL check("H5Ldelete_f", error, total_error) + + ! /* Close GCPL */ + CALL H5Pclose_f(gcpl, error) + CALL check("H5Pclose_f", error, total_error) + + ! /* Close file */ + CALL H5Fclose_f(fid,error) + CALL check("H5Fclose_f",error,total_error) + +!!$ /* Get size of file as empty */ +!!$ if((file_size = h5_get_file_size(filename)) < 0) TEST_ERROR +!!$ +!!$ /* Verify that file is correct size */ +!!$ if(file_size != empty_size) TEST_ERROR + + IF(cleanup) CALL h5_cleanup_f("fixx", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + END SUBROUTINE lifecycle +!/*------------------------------------------------------------------------- +! * Function: cklinks +! * +! * Purpose: Open the file created in the first step and check that the +! * links look correct. +! * +! * Return: Success: 0 +! * +! * Failure: -1 +! * +! * Programmer: M.S. Breitenfeld +! * April 14, 2008 +! * +! * Modifications: Modified Original C code +! * +! *------------------------------------------------------------------------- +! */ + + + SUBROUTINE cklinks(fapl, total_error) + +! USE ISO_C_BINDING + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER :: error + + INTEGER(HID_T) :: file +! H5O_info_t oinfo1, oinfo2; +! H5L_info_t linfo2; + + CHARACTER(LEN=12), PARAMETER :: filename ='TestLinks.h5' + CHARACTER(LEN=12) :: linkval + +! TYPE(C_PTR) :: linkval + + LOGICAL :: Lexists + + +!!$ if(new_format) +!!$ TESTING("link queries (w/new group format)") +!!$ else +!!$ TESTING("link queries") + + ! /* Open the file */ + CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, error,access_prp=fapl) + CALL check("H5Fopen_f",error,total_error) + + + ! /* Hard link */ +!!$ IF(H5Oget_info_by_name(file, "d1", &oinfo1, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ IF(H5Oget_info_by_name(file, "grp1/hard", &oinfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ IF(H5O_TYPE_DATASET != oinfo2.type) { +!!$ H5_FAILED(); +!!$ printf(" %d: Unexpected object type should have been a dataset\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5F_addr_ne(oinfo1.addr, oinfo2.addr)) { +!!$ H5_FAILED(); +!!$ puts(" Hard link test failed. Link seems not to point to the "); +!!$ puts(" expected file location."); +!!$ TEST_ERROR +!!$ } /* end if */ + + + CALL H5Lexists_f(file,"d1",Lexists, error) + CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + + CALL H5Lexists_f(file,"grp1/hard",Lexists, error) + CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + + +!!$ /* Symbolic link */ +!!$ if(H5Oget_info_by_name(file, "grp1/soft", &oinfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ if(H5O_TYPE_DATASET != oinfo2.type) { +!!$ H5_FAILED(); +!!$ printf(" %d: Unexpected object type should have been a dataset\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5F_addr_ne(oinfo1.addr, oinfo2.addr)) { +!!$ H5_FAILED(); +!!$ puts(" Soft link test failed. Link seems not to point to the "); +!!$ puts(" expected file location."); +!!$ TEST_ERROR +!!$ } /* end if */ + +! CALL H5Lget_val(file, "grp1/soft", INT(LEN(linkval), SIZE_T), linkval, error) + + +!!$ if(H5Lget_val(file, "grp1/soft", linkval, sizeof linkval, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ if(HDstrcmp(linkval, "/d1")) { +!!$ H5_FAILED(); +!!$ puts(" Soft link test failed. Wrong link value"); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lexists(file, "grp1/soft", H5P_DEFAULT) != TRUE) FAIL_STACK_ERROR +!!$ +!!$ /* Dangling link */ +!!$ H5E_BEGIN_TRY { +!!$ status = H5Oget_info_by_name(file, "grp1/dangle", &oinfo2, H5P_DEFAULT); +!!$ } H5E_END_TRY; +!!$ if(status >= 0) { +!!$ H5_FAILED(); +!!$ puts(" H5Oget_info_by_name() should have failed for a dangling link."); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lget_info(file, "grp1/dangle", &linfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ if(H5L_TYPE_SOFT != linfo2.type) { +!!$ H5_FAILED(); +!!$ printf(" %d: Unexpected object type should have been a symbolic link\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lget_val(file, "grp1/dangle", linkval, sizeof linkval, H5P_DEFAULT) < 0) { +!!$ H5_FAILED(); +!!$ printf(" %d: Can't retrieve link value\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(HDstrcmp(linkval, "foobar")) { +!!$ H5_FAILED(); +!!$ puts(" Dangling link test failed. Wrong link value"); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lexists(file, "grp1/dangle", H5P_DEFAULT) != TRUE) FAIL_STACK_ERROR +!!$ +!!$ /* Recursive link */ +!!$ H5E_BEGIN_TRY { +!!$ status = H5Oget_info_by_name(file, "grp1/recursive", &oinfo2, H5P_DEFAULT); +!!$ } H5E_END_TRY; +!!$ if(status >= 0) { +!!$ H5_FAILED(); +!!$ puts(" H5Oget_info_by_name() should have failed for a recursive link."); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lget_info(file, "grp1/recursive", &linfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR +!!$ if(H5L_TYPE_SOFT != linfo2.type) { +!!$ H5_FAILED(); +!!$ printf(" %d: Unexpected object type should have been a symbolic link\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(H5Lget_val(file, "grp1/recursive", linkval, sizeof linkval, H5P_DEFAULT) < 0) { +!!$ H5_FAILED(); +!!$ printf(" %d: Can't retrieve link value\n", __LINE__); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ if(HDstrcmp(linkval, "/grp1/recursive")) { +!!$ H5_FAILED(); +!!$ puts(" Recursive link test failed. Wrong link value"); +!!$ TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Non-existant link */ +!!$ if(H5Lexists(file, "foobar", H5P_DEFAULT) == TRUE) FAIL_STACK_ERROR + + ! /* Cleanup */ + CALL H5Fclose_f(file,error) + CALL check("H5Fclose_f",error,total_error) + + END SUBROUTINE cklinks + + +!/*------------------------------------------------------------------------- +! * Function: delete_by_idx +! * +! * Purpose: Create a group with creation order indices and test deleting +! * links by index. +! * +! * Return: Total error +! * +! * C Programmer: Quincey Koziol +! * Tuesday, November 14, 2006 +! * +! * Adapted to FORTRAN: M.S. Breitenfeld +! * March 3, 2008 +! * +! *------------------------------------------------------------------------- +! */ +SUBROUTINE delete_by_idx(cleanup, fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + + INTEGER(HID_T) :: file_id ! /* File ID */ + INTEGER(HID_T) :: group_id ! /* Group ID */ + INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */ + + INTEGER :: idx_type ! /* Type of index to operate on */ + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + ! /* Use index on creation order values */ + INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */ + INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */ + + CHARACTER(LEN=7) :: objname ! /* Object name */ + CHARACTER(LEN=8) :: filename = 'file0.h5' ! /* File name */ + CHARACTER(LEN=7) :: tmpname ! /* Temporary link name */ + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" + + LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute + + INTEGER :: u ! /* Local index variable */ + INTEGER :: Input1, i + INTEGER(HID_T) :: group_id2 + + INTEGER :: iorder ! /* Order within in the index */ + CHARACTER(LEN=2) :: chr2 + INTEGER :: error + ! + ! + ! + CHARACTER(LEN=6) :: filename1 + CHARACTER(LEN=6) :: filename2 + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=80) :: fix_filename2 + INTEGER(SIZE_T) :: size_tmp + + LOGICAL :: cleanup + + DO i = 1, 80 + fix_filename1(i:i) = " " + fix_filename2(i:i) = " " + ENDDO + + ! /* Loop over operating on different indices on link fields */ + DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F + ! /* Loop over operating in different orders */ + DO iorder = H5_ITER_INC_F, H5_ITER_DEC_F + ! /* Loop over using index for creation order value */ + DO i = 1, 2 + ! /* Print appropriate test message */ + IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN + IF(iorder == H5_ITER_INC_F)THEN + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"deleting links by creation order index in increasing order w/o creation order index" + ENDIF + ELSE + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"deleting links by creation order index in decreasing order w/o creation order index" + ENDIF + ENDIF + ELSE + IF(iorder == H5_ITER_INC_F)THEN + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"deleting links by name index in increasing order w/o creation order index" + ENDIF + ELSE + IF(use_index(i))THEN + WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/creation order index" + ELSE + WRITE(*,'(5x,A)')"deleting links by name index in decreasing order w/o creation order index" + ENDIF + ENDIF + ENDIF +! CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) +! IF(error .NE. 0) STOP + + ! /* Create file */ + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl) + CALL check("delete_by_idx.H5Fcreate_f", error, total_error) + + ! /* Create group creation property list */ + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error ) + CALL check("delete_by_idx.H5Pcreate_f", error, total_error) + + ! /* Set creation order tracking & indexing on group */ + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error) + CALL check("delete_by_idx.H5Pset_link_creation_order_f", error, total_error) + + ! /* Create group with creation order tracking on */ + CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id) + CALL check("delete_by_idx.H5Gcreate_f", error, total_error) + + ! /* Query the group creation properties */ + CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error) + CALL check("delete_by_idx.H5Pget_link_phase_change_f", error, total_error) + + + ! /* Delete links from one end */ + + ! /* Check for deletion on empty group */ + CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error) + CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) + ! /* Create several links, up to limit of compact form */ + DO u = 0, max_compact-1 + ! /* Make name for link */ + WRITE(chr2,'(I2.2)') u + objname = 'fill '//chr2 + + ! /* Create hard link, with group object */ + CALL H5Gcreate_f(group_id, objname, group_id2, error) + CALL check("delete_by_idx.H5Gcreate_f", error, total_error) + CALL H5Gclose_f(group_id2, error) + CALL check("delete_by_idx.H5Gclose_f", error, total_error) + + ! /* Verify link information for new link */ + CALL link_info_by_idx_check(group_id, objname, u, & + .TRUE., use_index, total_error) + ENDDO + + ! /* Verify state of group (compact) */ + ! IF(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR + + ! /* Check for out of bound deletion */ + + CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error) + CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1) + + + ! /* Delete links from compact group */ + + DO u = 0, (max_compact - 1) -1 + ! /* Delete first link in appropriate order */ + CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error) + CALL check("delete_by_idx.H5Ldelete_by_idx_f", error, total_error) + ! /* Verify the link information for first link in appropriate order */ + ! HDmemset(&linfo, 0, sizeof(linfo)); + + CALL H5Lget_info_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + + IF(iorder.EQ.H5_ITER_INC_F)THEN + CALL VERIFY("delete_by_idx.H5Lget_info_by_idx_f", corder, u+1, total_error) + ELSE + CALL VERIFY("delete_by_idx.H5Lget_info_by_idx_f", corder, (max_compact - (u + 2)), total_error) + ENDIF + + ! /* Verify the name for first link in appropriate order */ + ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ size_tmp = 20 +!!$ CALL H5Lget_name_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), size_tmp, tmpname, error) +!!$ CALL check("delete_by_idx.H5Lget_name_by_idx_f", error, total_error) +!!$ +!!$ IF(order .EQ. H5_ITER_INC_F)THEN +!!$ WRITE(chr2,'(I2.2)') u + 1 +!!$ ELSE +!!$ WRITE(chr2,'(I2.2)') (max_compact - (u + 2)) +!!$ ENDIF +!!$ objname = 'fill '//chr2 +!!$ PRINT*,objname, tmpname +!!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error) + ENDDO +!!$ +!!$ /* Delete last link */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify state of group (empty) */ +!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR +!!$ +!!$ /* Create more links, to push group into dense form */ +!!$ for(u = 0; u < (max_compact * 2); u++) { +!!$ hid_t group_id2; /* Group ID */ +!!$ +!!$ /* Make name for link */ +!!$ sprintf(objname, "filler %02u", u); +!!$ +!!$ /* Create hard link, with group object */ +!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR +!!$ +!!$ /* Verify state of group (dense) */ +!!$ if(u >= max_compact) +!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR +!!$ +!!$ /* Verify link information for new link */ +!!$ if(link_info_by_idx_check(group_id, objname, (hsize_t)u, TRUE, use_index) < 0) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Check for out of bound deletion again */ +!!$ H5E_BEGIN_TRY { +!!$ ret = H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT); +!!$ } H5E_END_TRY; +!!$ if(ret >= 0) TEST_ERROR +!!$ +!!$ /* Delete links from dense group, in appropriate order */ +!!$ for(u = 0; u < ((max_compact * 2) - 1); u++) { +!!$ /* Delete first link in appropriate order */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for first link in appropriate order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) { +!!$ if(linfo.corder != (u + 1)) TEST_ERROR +!!$ } /* end if */ +!!$ else { +!!$ if(linfo.corder != ((max_compact * 2) - (u + 2))) TEST_ERROR +!!$ } /* end else */ +!!$ +!!$ /* Verify the name for first link in appropriate order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) +!!$ sprintf(objname, "filler %02u", (u + 1)); +!!$ else +!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - (u + 2))); +!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Delete last link */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify state of group (empty) */ +!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR +!!$ if(H5G_is_new_dense_test(group_id) == TRUE) TEST_ERROR +!!$ +!!$ /* Check for deletion on empty group again */ +!!$ H5E_BEGIN_TRY { +!!$ ret = H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT); +!!$ } H5E_END_TRY; +!!$ if(ret >= 0) TEST_ERROR +!!$ +!!$ +!!$ /* Delete links in middle */ +!!$ +!!$ +!!$ /* Create more links, to push group into dense form */ +!!$ for(u = 0; u < (max_compact * 2); u++) { +!!$ hid_t group_id2; /* Group ID */ +!!$ +!!$ /* Make name for link */ +!!$ sprintf(objname, "filler %02u", u); +!!$ +!!$ /* Create hard link, with group object */ +!!$ if((group_id2 = H5Gcreate2(group_id, objname, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ if(H5Gclose(group_id2) < 0) TEST_ERROR +!!$ +!!$ /* Verify state of group (dense) */ +!!$ if(u >= max_compact) +!!$ if(H5G_is_new_dense_test(group_id) != TRUE) TEST_ERROR +!!$ +!!$ /* Verify link information for new link */ +!!$ if(link_info_by_idx_check(group_id, objname, (hsize_t)u, TRUE, use_index) < 0) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Delete every other link from dense group, in appropriate order */ +!!$ for(u = 0; u < max_compact; u++) { +!!$ /* Delete link */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)u, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for current link in appropriate order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)u, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) { +!!$ if(linfo.corder != ((u * 2) + 1)) TEST_ERROR +!!$ } /* end if */ +!!$ else { +!!$ if(linfo.corder != ((max_compact * 2) - ((u * 2) + 2))) TEST_ERROR +!!$ } /* end else */ +!!$ +!!$ /* Verify the name for current link in appropriate order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)u, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) +!!$ sprintf(objname, "filler %02u", ((u * 2) + 1)); +!!$ else +!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - ((u * 2) + 2))); +!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Delete remaining links from dense group, in appropriate order */ +!!$ for(u = 0; u < (max_compact - 1); u++) { +!!$ /* Delete link */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for first link in appropriate order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", idx_type, order, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) { +!!$ if(linfo.corder != ((u * 2) + 3)) TEST_ERROR +!!$ } /* end if */ +!!$ else { +!!$ if(linfo.corder != ((max_compact * 2) - ((u * 2) + 4))) TEST_ERROR +!!$ } /* end else */ +!!$ +!!$ /* Verify the name for first link in appropriate order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", idx_type, order, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(order == H5_ITER_INC) +!!$ sprintf(objname, "filler %02u", ((u * 2) + 3)); +!!$ else +!!$ sprintf(objname, "filler %02u", ((max_compact * 2) - ((u * 2) + 4))); +!!$ if(HDstrcmp(objname, tmpname)) TEST_ERROR +!!$ } /* end for */ +!!$ +!!$ /* Delete last link */ +!!$ if(H5Ldelete_by_idx(group_id, ".", idx_type, order, (hsize_t)0, H5P_DEFAULT) < 0) TEST_ERROR +!!$ +!!$ /* Verify state of group (empty) */ +!!$ if(H5G_has_links_test(group_id, NULL) == TRUE) TEST_ERROR +!!$ if(H5G_is_new_dense_test(group_id) == TRUE) TEST_ERROR +!!$ +!!$ +!!$ + ! /* Close the group */ + CALL H5Gclose_f(group_id, error) + CALL check("delete_by_idx.H5Gclose_f", error, total_error) + + !/* Close the group creation property list */ + CALL H5Pclose_f(gcpl_id, error) + CALL check("delete_by_idx.H5Gclose_f", error, total_error) + + !/* Close the file */ + CALL H5Fclose_f(file_id, error) + CALL check("delete_by_idx.H5Gclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("file0", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + ENDDO + ENDDO + ENDDO +!!$ +!!$ return 0; +!!$ +!!$error: +!!$ H5E_BEGIN_TRY { +!!$ H5Pclose(gcpl_id); +!!$ H5Gclose(group_id); +!!$ H5Fclose(file_id); +!!$ } H5E_END_TRY; +!!$ return -1; +!!$} /* end delete_by_idx() */ + +END SUBROUTINE delete_by_idx + + + +!/*------------------------------------------------------------------------- +! * Function: link_info_by_idx_check +! * +! * Purpose: Support routine for link_info_by_idx, to verify the link +! * info is correct for a link +! * +! * Note: This routine assumes that the links have been inserted in the +! * group in alphabetical order. +! * +! * Return: Success: 0 +! * Failure: -1 +! * +! * Programmer: Quincey Koziol +! * Tuesday, November 7, 2006 +! * +! *------------------------------------------------------------------------- +! */ +SUBROUTINE link_info_by_idx_check(group_id, linkname, n, & + hard_link, use_index, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: group_id + CHARACTER(LEN=*), INTENT(IN) :: linkname + INTEGER, INTENT(IN) :: n + LOGICAL, INTENT(IN) :: hard_link + LOGICAL, INTENT(IN) :: use_index + + LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute + INTEGER :: corder ! Is a positive integer containing the creation order of the attribute + INTEGER :: cset ! Indicates the character set used for the attribute’s name + INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute + + CHARACTER(LEN=7) :: tmpname !/* Temporary link name */ + CHARACTER(LEN=3) :: tmpname_small !/* to small temporary link name */ + CHARACTER(LEN=10) :: tmpname_big !/* to big temporary link name */ + + CHARACTER(LEN=7) :: valname !/* Link value name */ + CHARACTER(LEN=7) :: tmpval !/* Temporary link value */ + CHARACTER(LEN=2) :: chr2 + INTEGER(SIZE_T) :: size_tmp + INTEGER :: error + + ! /* Make link value for increasing/native order queries */ + + WRITE(chr2,'(I2.2)') n + valname = 'valn.'//chr2 + + ! /* Verify the link information for first link, in increasing creation order */ + ! HDmemset(&linfo, 0, sizeof(linfo)); + CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + CALL check("H5Lget_info_by_idx_f", error, total_error) + CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error) + + ! /* Verify the link information for new link, in increasing creation order */ + ! HDmemset(&linfo, 0, sizeof(linfo)); + CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), & + f_corder_valid, corder, cset, data_size, error) + CALL check("H5Lget_info_by_idx_f", error, total_error) + CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error) + + ! /* Verify value for new soft link, in increasing creation order */ +!!$ IF(hard_link)THEN +!!$ ! HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); +!!$ +!!$ CALL H5Lget_val_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, n, tmpval, INT(7,SIZE_T),error) +!!$ CALL check("H5Lget_val_by_idx",error,total_error) +!!$ +!!$! IF(HDstrcmp(valname, tmpval)) TEST_ERROR +!!$ ENDIF + + ! /* Verify the name for new link, in increasing creation order */ + ! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); + + ! The actual size of tmpname should be 7 + + size_tmp = INT(3,SIZE_T) + CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), size_tmp, tmpname_small, error) + CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error) + CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", & + linkname(1:LEN(tmpname_small)), tmpname_small(1:LEN(tmpname_small)), total_error) + CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error) + + ! try it with the correct size + size_tmp = INT(LEN(tmpname),SIZE_T) + CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), size_tmp, tmpname, error) + CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error) + CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", & + linkname(1:LEN(tmpname)), tmpname(1:LEN(tmpname)), total_error) + CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error) + + size_tmp = INT(LEN(tmpname_big),SIZE_T) + CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), size_tmp, tmpname_big, error) + CALL check("link_info_by_idx_check.H5Lget_name_by_idx_f", error, total_error) + CALL verifyString("link_info_by_idx_check.H5Lget_name_by_idx_f", & + linkname(1:7), tmpname_big(1:7), total_error) + CALL VERIFY("link_info_by_idx_check.H5Lget_name_by_idx_f", INT(size_tmp), 7, total_error) + + ! Try with a buffer set to small + +!!$ size_tmp = INT(4,SIZE_T) +!!$ CALL H5Lget_name_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), size_tmp, tmpname, error) +!!$ CALL check("H5Lget_name_by_idx_f", error, total_error) +!!$ CALL verifyString("H5Lget_name_by_idx_f", linkname, tmpname, total_error) + + +!!$ +!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR + +!!$ /* Don't test "native" order if there is no creation order index, since +!!$ * there's not a good way to easily predict the link's order in the name +!!$ * index. +!!$ */ +!!$ if(use_index) { +!!$ /* Verify the link information for first link, in native creation order (which is increasing) */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for new link, in native creation order (which is increasing) */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != (int64_t)n) TEST_ERROR +!!$ +!!$ /* Verify value for new soft link, in native creation order (which is increasing) */ +!!$ if(!hard_link) { +!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for new link, in native creation order (which is increasing) */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_NATIVE, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Verify the link information for first link, in decreasing creation order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for new link, in decreasing creation order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != (int64_t)n) TEST_ERROR +!!$ +!!$ /* Verify value for new soft link, in decreasing creation order */ +!!$ if(!hard_link) { +!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for new link, in decreasing creation order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_CRT_ORDER, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR +!!$ +!!$ +!!$ /* Verify the link information for first link, in increasing link name order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for new link, in increasing link name order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != (int64_t)n) TEST_ERROR +!!$ +!!$ /* Verify value for new soft link, in increasing link name order */ +!!$ if(!hard_link) { +!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for new link, in increasing link name order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_INC, n, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR +!!$ +!!$ /* Don't test "native" order queries on link name order, since there's not +!!$ * a good way to easily predict the order of the links in the name index. +!!$ */ +!!$ +!!$ /* Verify the link information for first link, in decreasing link name order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, n, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != 0) TEST_ERROR +!!$ +!!$ /* Verify the link information for new link, in decreasing link name order */ +!!$ HDmemset(&linfo, 0, sizeof(linfo)); +!!$ if(H5Lget_info_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, &linfo, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(linfo.corder != (int64_t)n) TEST_ERROR +!!$ +!!$ /* Verify value for new soft link, in decreasing link name order */ +!!$ if(!hard_link) { +!!$ HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_val_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpval, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(valname, tmpval)) TEST_ERROR +!!$ } /* end if */ +!!$ +!!$ /* Verify the name for new link, in decreasing link name order */ +!!$ HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE); +!!$ if(H5Lget_name_by_idx(group_id, ".", H5_INDEX_NAME, H5_ITER_DEC, (hsize_t)0, tmpname, (size_t)NAME_BUF_SIZE, H5P_DEFAULT) < 0) TEST_ERROR +!!$ if(HDstrcmp(linkname, tmpname)) TEST_ERROR +!!$ +!!$ /* Success */ +!!$ return(0); +!!$ +!!$error: +!!$ /* Failure */ +!!$ return(-1); +!!$} /* end link_info_by_idx_check() */ + + END SUBROUTINE link_info_by_idx_check + + +!/*------------------------------------------------------------------------- +! * Function: test_lcpl +! * +! * Purpose: Tests Link Creation Property Lists +! * +! * Return: Success: 0 +! * Failure: number of errors +! * +! * Programmer: M.S. Breitenfeld +! * Modified C routine +! * March 12, 2008 +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + + + SUBROUTINE test_lcpl(cleanup, fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + LOGICAL :: cleanup + + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: group_id + INTEGER(HID_T) :: space_id, data_space + INTEGER(HID_T) :: dset_id + INTEGER(HID_T) :: type_id + INTEGER(HID_T) :: lcpl_id + + INTEGER :: cset ! Indicates the character set used for the link’s name. + INTEGER :: corder ! Specifies the link’s creation order position. + LOGICAL :: f_corder_valid ! Indicates whether the value in corder is valid. + INTEGER :: link_type ! Specifies the link class: + ! H5L_LINK_HARD_F - Hard link + ! H5L_LINK_SOFT_F - Soft link + ! H5L_LINK_EXTERNAL_F - External link + ! H5L_LINK_ERROR _F - Error + INTEGER :: address ! If the link is a hard link, address specifies the file address that the link points to + INTEGER(HSIZE_T) :: val_size ! If the link is a symbolic link, val_size will be the length of the link value + INTEGER(HSIZE_T) :: data_size ! Indicates the size, in the number of characters, of the attribute + + CHARACTER(LEN=1024) :: filename = 'tempfile.h5' + INTEGER, PARAMETER :: TEST6_DIM1 = 8, TEST6_DIM2 = 7 + INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: dims = (/TEST6_DIM1,TEST6_DIM2/) + + INTEGER :: encoding + INTEGER :: error + LOGICAL :: Lexists + INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: extend_dim = (/TEST6_DIM1-2,TEST6_DIM2-3/) + INTEGER(HSIZE_T), DIMENSION(1:2) :: dimsout, maxdimsout ! dimensions + + INTEGER :: i + + WRITE(*,*) "link creation property lists (w/new group format)" + + + !/* Actually, intermediate group creation is tested elsewhere (tmisc). + ! * Here we only need to test the character encoding property */ + + !/* Create file */ + ! h5_fixname(FILENAME[0], fapl, filename, sizeof filename); + + CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL check("test_lcpl.H5Fcreate_f", error, total_error) + + + ! /* Create and link a group with the default LCPL */ + + CALL H5Gcreate_f(file_id, "/group", group_id, error) + CALL check("test_lcpl.H5Gcreate_f", error, total_error) + + + ! /* Check that its character encoding is the default */ + + CALL H5Lget_info_f(file_id, "group", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error, H5P_DEFAULT_F) + +!/* File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. */ +!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- + + CALL VERIFY("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + + ! /* Create and commit a datatype with the default LCPL */ + CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) + CALL check("test_lcpl.h5tcopy_f",error,total_error) + CALL h5tcommit_f(file_id, "/type", type_id, error) + CALL check("test_lcpl.h5tcommit_f", error, total_error) + CALL h5tclose_f(type_id, error) + CALL check("test_lcpl.h5tclose_f", error, total_error) + + + ! /* Check that its character encoding is the default */ + CALL H5Lget_info_f(file_id, "type", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.h5tclose_f", error, total_error) + +!/* File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. */ +!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- + + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + + !/* Create a dataspace */ + CALL h5screate_simple_f(2, dims, space_id, error) + CALL check("test_lcpl.h5screate_simple_f",error,total_error) + + ! /* Create a dataset using the default LCPL */ + CALL h5dcreate_f(file_id, "/dataset", H5T_NATIVE_INTEGER, space_id, dset_id, error) + CALL check("test_lcpl.h5dcreate_f", error, total_error) + CALL h5dclose_f(dset_id, error) + CALL check("test_lcpl.h5dclose_f", error, total_error) + + ! Reopen + + CALL H5Dopen_f(file_id, "/dataset", dset_id, error) + CALL check("test_lcpl.h5dopen_f", error, total_error) + + ! /* Extend the dataset */ + CALL H5Dset_extent_f(dset_id, extend_dim, error) + CALL check("test_lcpl.H5Dset_extent_f", error, total_error) + ! /* Verify the dataspaces */ + ! + !Get dataset's dataspace handle. + ! + CALL h5dget_space_f(dset_id, data_space, error) + CALL check("h5dget_space_f",error,total_error) + + CALL h5sget_simple_extent_dims_f(data_space, dimsout, maxdimsout, error) + CALL check("test_lcpl.h5sget_simple_extent_dims_f",error, total_error) + + DO i = 1, 2 + CALL VERIFY("H5Sget_simple_extent_dims", dimsout(i), extend_dim(i), total_error) + CALL VERIFY("H5Sget_simple_extent_dims", maxdimsout(i), dims(i), total_error) + ENDDO + + ! /* close data set */ + + CALL h5dclose_f(dset_id, error) + CALL check("test_lcpl.h5dclose_f", error, total_error) + + ! /* Check that its character encoding is the default */ + CALL H5Lget_info_f(file_id, "dataset", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + +!/* File-wide default character encoding can not yet be set via the file +! * creation property list and is always ASCII. */ +!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h -- + + CALL verify("test_lcpl.h5tclose_f",cset, H5T_CSET_ASCII_F,total_error) + + !/* Create a link creation property list with the UTF-8 character encoding */ + CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error) + CALL check("test_lcpl.h5Pcreate_f",error,total_error) + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) + CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + + ! /* Create and link a group with the new LCPL */ + CALL H5Gcreate_f(file_id, "/group2", group_id, error,lcpl_id=lcpl_id) + CALL check("test_lcpl.test_lcpl.H5Gcreate_f", error, total_error) + CALL H5Gclose_f(group_id, error) + CALL check("test_lcpl.test_lcpl.H5Gclose_f", error, total_error) + + + !/* Check that its character encoding is UTF-8 */ + CALL H5Lget_info_f(file_id, "group2", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + + + ! /* Create and commit a datatype with the new LCPL */ + + CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error) + CALL check("test_lcpl.h5tcopy_f",error,total_error) + CALL h5tcommit_f(file_id, "/type2", type_id, error, lcpl_id=lcpl_id) + CALL check("test_lcpl.h5tcommit_f", error, total_error) + CALL h5tclose_f(type_id, error) + CALL check("test_lcpl.h5tclose_f", error, total_error) + + + !/* Check that its character encoding is UTF-8 */ + CALL H5Lget_info_f(file_id, "type2", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + + ! /* Create a dataset using the new LCPL */ + CALL h5dcreate_f(file_id, "/dataset2", H5T_NATIVE_INTEGER, space_id, dset_id, error,lcpl_id=lcpl_id) + CALL check("test_lcpl.h5dcreate_f", error, total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("test_lcpl.h5dclose_f", error, total_error) + + CALL H5Pget_char_encoding_f(lcpl_id, encoding, error) + CALL check("test_lcpl.H5Pget_char_encoding_f", error, total_error) + CALL VERIFY("test_lcpl.H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error) + + ! /* Check that its character encoding is UTF-8 */ + CALL H5Lget_info_f(file_id, "dataset2", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f2",cset, H5T_CSET_UTF8_F,total_error) + + ! /* Create a new link to the dataset with a different character encoding. */ + CALL H5Pclose_f(lcpl_id, error) + CALL check("test_lcpl.H5Pclose_f", error, total_error) + + CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error) + CALL check("test_lcpl.h5Pcreate_f",error,total_error) + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error) + CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL H5Lcreate_hard_f(file_id, "/dataset2", file_id, "/dataset2_link", error, lcpl_id) + CALL check("test_lcpl.H5Lcreate_hard_f",error, total_error) + + CALL H5Lexists_f(file_id,"/dataset2_link",Lexists, error) + CALL check("test_lcpl.H5Lexists",error, total_error) + CALL verifylogical("test_lcpl.H5Lexists", Lexists,.TRUE.,total_error) + + ! /* Check that its character encoding is ASCII */ + CALL H5Lget_info_f(file_id, "/dataset2_link", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + + ! /* Check that the first link's encoding hasn't changed */ + + CALL H5Lget_info_f(file_id, "/dataset2", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f3",cset, H5T_CSET_UTF8_F,total_error) + + + !/* Make sure that LCPLs work properly for other API calls: */ + !/* H5Lcreate_soft */ + + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) + CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + CALL H5Lcreate_soft_f("dataset2", file_id, "slink_to_dset2",error,lcpl_id) + CALL check("H5Lcreate_soft_f", error, total_error) + + CALL H5Lget_info_f(file_id, "slink_to_dset2", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + + + ! /* H5Lmove */ + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error) + CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + + CALL H5Lmove_f(file_id, "slink_to_dset2", file_id, "moved_slink", error, lcpl_id, H5P_DEFAULT_F) + CALL check("test_lcpl.H5Lmove_f",error, total_error) + + CALL H5Lget_info_f(file_id, "moved_slink", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error) + + + ! /* H5Lcopy */ + + CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error) + CALL check("test_lcpl.H5Pset_char_encoding_f",error, total_error) + + CALL H5Lcopy_f(file_id, "moved_slink", file_id, "copied_slink", error, lcpl_id) + + CALL H5Lget_info_f(file_id, "copied_slink", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + + + ! /* H5Lcreate_external */ + + CALL H5Lcreate_external_f("test_lcpl.filename", "path", file_id, "extlink", error, lcpl_id) + CALL check("test_lcpl.H5Lcreate_external_f", error, total_error) + + CALL H5Lget_info_f(file_id, "extlink", & + cset, corder, f_corder_valid, link_type, address, val_size, & + error) + CALL check("test_lcpl.H5Lget_info_f", error, total_error) + CALL verify("test_lcpl.H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error) + + + ! /* Close open IDs */ + + CALL H5Pclose_f(lcpl_id, error) + CALL check("test_lcpl.H5Pclose_f", error, total_error) + CALL H5Sclose_f(space_id, error) + CALL check("test_lcpl.h5Sclose_f",error,total_error) + CALL H5Fclose_f(file_id, error) + CALL check("test_lcpl.H5Fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("tempfile", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + +END SUBROUTINE test_lcpl + +SUBROUTINE objcopy(fapl, total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T), INTENT(IN) :: fapl + + INTEGER(HID_T) :: fapl2, pid + + INTEGER :: flag, cpy_flags + + INTEGER :: error + + flag = H5O_COPY_SHALLOW_HIERARCHY_F + +!/* Copy the file access property list */ + CALL H5Pcopy_f(fapl, fapl2, error) + CALL check("H5Pcopy_f", error, total_error) + +!/* Set the "use the latest version of the format" bounds for creating objects in the file */ + CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + + ! /* create property to pass copy options */ + CALL h5pcreate_f(H5P_OBJECT_COPY_F, pid, error) + CALL check("h5pcreate_f",error, total_error) + + ! /* set options for object copy */ + CALL H5Pset_copy_object_f(pid, flag, error) + CALL check("H5Pset_copy_object_f",error, total_error) + + ! /* Verify object copy flags */ + CALL H5Pget_copy_object_f(pid, cpy_flags, error) + CALL check("H5Pget_copy_object_f",error, total_error) + CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error) + +!!$ +!!$ CALL test_copy_option(fcpl_src, fcpl_dst, my_fapl, H5O_COPY_WITHOUT_ATTR_FLAG, +!!$ FALSE, "H5Ocopy(): without attributes"); + + CALL lapl_nlinks(fapl2, total_error) + +END SUBROUTINE objcopy + + +!/*------------------------------------------------------------------------- +! * Function: lapl_nlinks +! * +! * Purpose: Check that the maximum number of soft links can be adjusted +! * by the user using the Link Access Property List. +! * +! * Return: Success: 0 +! * +! * Failure: -1 +! * +! * Programmer: James Laird +! * Tuesday, June 6, 2006 +! * +! * Modifications: +! * +! *------------------------------------------------------------------------- +! */ + +SUBROUTINE lapl_nlinks( fapl, total_error) + + USE HDF5 + + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: fapl + INTEGER, INTENT(INOUT) :: total_error + + INTEGER :: error + + INTEGER(HID_T) :: fid = (-1) !/* File ID */ + INTEGER(HID_T) :: gid = (-1), gid2 = (-1) !/* Group IDs */ + INTEGER(HID_T) :: plist = (-1) ! /* lapl ID */ + INTEGER(HID_T) :: tid = (-1), sid = (-1), did = (-1) ! /* Other IDs */ + INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! /* Other property lists */ + + CHARACTER(LEN=7) :: objname ! /* Object name */ + INTEGER(size_t) :: name_len ! /* Length of object name */ + CHARACTER(LEN=12) :: filename = 'TestLinks.h5' + INTEGER(size_t) :: nlinks ! /* nlinks for H5Pset_nlinks */ + INTEGER(hsize_t), DIMENSION(2) :: dims + INTEGER(size_t) :: buf_size = 7 + + WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)" + +!!$ /* Make certain test is valid */ +!!$ /* XXX: should probably make a "generic" test that creates the proper +!!$ * # of links based on this value - QAK +!!$ */ +!!$ HDassert(H5L_NUM_LINKS == 16); + + ! /* Create file */ + CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl) + CALL check(" lapl_nlinks.h5fcreate_f",error,total_error) + + ! /* Create group with short name in file (used as target for links) */ + CALL H5Gcreate_f(fid, "final", gid, error) + CALL check(" lapl_nlinks.H5Gcreate_f", error, total_error) + + !/* Create chain of soft links to existing object (limited) */ + CALL H5Lcreate_soft_f("final", fid, "soft1", error) + CALL H5Lcreate_soft_f("soft1", fid, "soft2", error) + CALL H5Lcreate_soft_f("soft2", fid, "soft3", error) + CALL H5Lcreate_soft_f("soft3", fid, "soft4", error) + CALL H5Lcreate_soft_f("soft4", fid, "soft5", error) + CALL H5Lcreate_soft_f("soft5", fid, "soft6", error) + CALL H5Lcreate_soft_f("soft6", fid, "soft7", error) + CALL H5Lcreate_soft_f("soft7", fid, "soft8", error) + CALL H5Lcreate_soft_f("soft8", fid, "soft9", error) + CALL H5Lcreate_soft_f("soft9", fid, "soft10", error) + CALL H5Lcreate_soft_f("soft10", fid, "soft11", error) + CALL H5Lcreate_soft_f("soft11", fid, "soft12", error) + CALL H5Lcreate_soft_f("soft12", fid, "soft13", error) + CALL H5Lcreate_soft_f("soft13", fid, "soft14", error) + CALL H5Lcreate_soft_f("soft14", fid, "soft15", error) + CALL H5Lcreate_soft_f("soft15", fid, "soft16", error) + CALL H5Lcreate_soft_f("soft16", fid, "soft17", error) + + !/* Close objects */ + CALL H5Gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + !/* Open file */ + + CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl) + CALL check("h5open_f",error,total_error) + + !/* Create LAPL with higher-than-usual nlinks value */ + !/* Create a non-default lapl with udata set to point to the first group */ + + CALL H5Pcreate_f(H5P_LINK_ACCESS_F,plist,error) + CALL check("h5Pcreate_f",error,total_error) + nlinks = 20 + CALL H5Pset_nlinks_f(plist, nlinks, error) + CALL check("H5Pset_nlinks_f",error,total_error) + !/* Ensure that nlinks was set successfully */ + nlinks = 0 + CALL H5Pget_nlinks_f(plist, nlinks, error) + CALL check("H5Pset_nlinks_f",error,total_error) + CALL VERIFY("H5Pset_nlinks_f",INT(nlinks), 20, total_error) + + + !/* Open object through what is normally too many soft links using + ! * new property list */ + + CALL H5Oopen_f(fid,"soft17",gid,error,plist) + CALL check("H5Oopen_f",error,total_error) + + !/* Check name */ + CALL h5iget_name_f(gid, objname, buf_size, name_len, error) + CALL check("h5iget_name_f",error,total_error) + CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft17", total_error) + !/* Create group using soft link */ + CALL H5Gcreate_f(gid, "new_soft", gid2, error) + CALL check("H5Gcreate_f", error, total_error) + + ! /* Close groups */ + CALL H5Gclose_f(gid2, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(gid, error) + CALL check("H5Gclose_f", error, total_error) + + + !/* Set nlinks to a smaller number */ + nlinks = 4 + CALL H5Pset_nlinks_f(plist, nlinks, error) + CALL check("H5Pset_nlinks_f", error, total_error) + + !/* Ensure that nlinks was set successfully */ + nlinks = 0 + + CALL H5Pget_nlinks_f(plist, nlinks, error) + CALL check("H5Pget_nlinks_f",error,total_error) + CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error) + + ! /* Try opening through what is now too many soft links */ + + CALL H5Oopen_f(fid,"soft5",gid,error,plist) + CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail + + ! /* Open object through lesser soft link */ + CALL H5Oopen_f(fid,"soft4",gid,error,plist) + CALL check("H5Oopen_",error,total_error) + + ! /* Check name */ + CALL h5iget_name_f(gid, objname, buf_size, name_len, error) + CALL check("h5iget_name_f",error,total_error) + CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft4", total_error) + + ! /* Test other functions that should use a LAPL */ + nlinks = 20 + CALL H5Pset_nlinks_f(plist, nlinks, error) + CALL check("H5Pset_nlinks_f", error, total_error) + + !/* Try copying and moving when both src and dst contain many soft links + ! * using a non-default LAPL + ! */ + CALL H5Lcopy_f(fid, "soft17", fid, "soft17/newer_soft", error, H5P_DEFAULT_F, plist) + CALL check("H5Lcopy_f",error,total_error) + + CALL H5Lmove_f(fid, "soft17/newer_soft", fid, "soft17/newest_soft", error, lapl_id=plist) + CALL check("H5Lmove_f",error, total_error) + + ! /* H5Olink */ + CALL H5Olink_f(gid, fid, "soft17/link_to_group", error, H5P_DEFAULT_F, plist) + CALL check("H5Olink_f", error, total_error) + + ! /* H5Lcreate_hard and H5Lcreate_soft */ + CALL H5Lcreate_hard_f(fid, "soft17", fid, "soft17/link2_to_group", error, H5P_DEFAULT_F, plist) + CALL check("H5Lcreate_hard_f", error, total_error) + + + CALL H5Lcreate_soft_f("/soft4", fid, "soft17/soft_link",error, H5P_DEFAULT_F, plist) + CALL check("H5Lcreate_soft_f", error, total_error) + + ! /* H5Ldelete */ + CALL h5ldelete_f(fid, "soft17/soft_link", error, plist) + CALL check("H5Ldelete_f", error, total_error) + +!!$ /* H5Lget_val and H5Lget_info */ +!!$ if(H5Lget_val(fid, "soft17", NULL, (size_t)0, plist) < 0) TEST_ERROR +!!$ if(H5Lget_info(fid, "soft17", NULL, plist) < 0) TEST_ERROR +!!$ + + ! /* H5Lcreate_external and H5Lcreate_ud */ + CALL H5Lcreate_external_f("filename", "path", fid, "soft17/extlink", error, H5P_DEFAULT_F, plist) + CALL check("H5Lcreate_external_f", error, total_error) + +!!$ if(H5Lregister(UD_rereg_class) < 0) TEST_ERROR +!!$ if(H5Lcreate_ud(fid, "soft17/udlink", UD_HARD_TYPE, NULL, (size_t)0, H5P_DEFAULT, plist) < 0) TEST_ERROR +!!$ + ! /* Close plist */ + CALL h5pclose_f(plist, error) + CALL check("h5pclose_f", error, total_error) + + ! /* Create a datatype and dataset as targets inside the group */ + CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error) + CALL check("h5tcopy_f",error,total_error) + CALL h5tcommit_f(gid, "datatype", tid, error) + CALL check("h5tcommit_f", error, total_error) + CALL h5tclose_f(tid, error) + CALL check("h5tclose_f", error, total_error) + +!!$ +!!$ dims[0] = 2; +!!$ dims[1] = 2; +!!$ if((sid = H5Screate_simple(2, dims, NULL)) < 0) TEST_ERROR +!!$ if((did = H5Dcreate2(gid, "dataset", H5T_NATIVE_INT, sid, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR +!!$ if(H5Dclose(did) < 0) TEST_ERROR +!!$ + !/* Close group */ + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + +!!$ +!!$ /* Try to open the objects using too many symlinks with default *APLs */ +!!$ H5E_BEGIN_TRY { +!!$ if((gid = H5Gopen2(fid, "soft17", H5P_DEFAULT)) >= 0) +!!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.") +!!$ if((tid = H5Topen2(fid, "soft17/datatype", H5P_DEFAULT)) >= 0) +!!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.") +!!$ if((did = H5Dopen2(fid, "soft17/dataset", H5P_DEFAULT)) >= 0) +!!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.") +!!$ } H5E_END_TRY +!!$ + ! /* Create property lists with nlinks set */ + + CALL H5Pcreate_f(H5P_GROUP_ACCESS_F,gapl,error) + CALL check("h5Pcreate_f",error,total_error) + CALL H5Pcreate_f(H5P_DATATYPE_ACCESS_F,tapl,error) + CALL check("h5Pcreate_f",error,total_error) + CALL H5Pcreate_f(H5P_DATASET_ACCESS_F,dapl,error) + CALL check("h5Pcreate_f",error,total_error) + + + nlinks = 20 + CALL H5Pset_nlinks_f(gapl, nlinks, error) + CALL check("H5Pset_nlinks_f", error, total_error) + CALL H5Pset_nlinks_f(tapl, nlinks, error) + CALL check("H5Pset_nlinks_f", error, total_error) + CALL H5Pset_nlinks_f(dapl, nlinks, error) + CALL check("H5Pset_nlinks_f", error, total_error) + + !/* We should now be able to use these property lists to open each kind + ! * of object. + ! */ + + CALL H5Gopen_f(fid, "soft17", gid, error, gapl) + CALL check("H5Gopen_f",error,total_error) + + CALL H5Topen_f(fid, "soft17/datatype", tid, error, tapl) + CALL check("H5Gopen_f",error,total_error) + +!!$ if((did = H5Dopen2(fid, "soft17/dataset", dapl)) < 0) TEST_ERROR + + ! /* Close objects */ + + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5tclose_f(tid, error) + CALL check("h5tclose_f", error, total_error) + +!!$ if(H5Dclose(did) < 0) TEST_ERROR +!!$ + ! /* Close plists */ + + CALL h5pclose_f(gapl, error) + CALL check("h5pclose_f", error, total_error) + CALL h5pclose_f(tapl, error) + CALL check("h5pclose_f", error, total_error) + +!!$ if(H5Pclose(dapl) < 0) TEST_ERROR +!!$ +!!$ /* Unregister UD hard link class */ +!!$ if(H5Lunregister(UD_HARD_TYPE) < 0) TEST_ERROR +!!$ + + ! /* Close file */ + CALL H5Fclose_f(fid, error) + CALL check("H5Fclose_f", error, total_error) + +END SUBROUTINE lapl_nlinks diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90 new file mode 100644 index 0000000..d0c3f16 --- /dev/null +++ b/fortran/test/tH5O.f90 @@ -0,0 +1,208 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! All rights reserved. * +! * +! This file is part of HDF5. The full HDF5 copyright notice, including * +! terms governing use, modification, and redistribution, is contained in * +! the files COPYING and Copyright.html. COPYING can be found at the root * +! of the source code distribution tree; Copyright.html can be found at the * +! root level of an installed copy of the electronic HDF5 document set and * +! is linked from the top-level documents page. It can also be found at * +! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * +! access to either file, you may request a copy from help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +SUBROUTINE test_h5o(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + ! /* Output message about test being performed */ + WRITE(*,*) "Testing Objects" + +!!$ test_h5o_open(); /* Test generic OPEN FUNCTION */ +!!$ test_h5o_open_by_addr(); /* Test opening objects by address */ +!!$ test_h5o_close(); /* Test generic CLOSE FUNCTION */ +!!$ test_h5o_refcount(); /* Test incrementing and decrementing reference count */ +!!$ test_h5o_plist(); /* Test object creation properties */ + CALL test_h5o_link(total_error) ! /* Test object link routine */ + +END SUBROUTINE test_h5o + +!/**************************************************************** +!** +!** test_h5o_link: Test creating link to object +!** +!****************************************************************/ + +SUBROUTINE test_h5o_link(total_error) + + USE HDF5 ! This module contains all necessary modules + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: total_error + + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: group_id + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: dset_id + INTEGER(HID_T) :: type_id + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: lcpl_id + CHARACTER(LEN=8), PARAMETER :: TEST_FILENAME = 'TestFile' + INTEGER, PARAMETER :: TEST6_DIM1 = 2, TEST6_DIM2 = 5 + INTEGER(HSIZE_T), DIMENSION(1:2), PARAMETER :: dims = (/TEST6_DIM1,TEST6_DIM2/) + INTEGER, DIMENSION(1:TEST6_DIM1,1:TEST6_DIM2) :: wdata, rdata + + INTEGER, PARAMETER :: TRUE = 1, FALSE = 0 + + LOGICAL :: committed ! /* Whether the named datatype is committed */ + + INTEGER :: i, n, j + INTEGER :: error ! /* Value returned from API calls */ + + ! /* Initialize the raw data */ + DO i = 1, TEST6_DIM1 + DO j = 1, TEST6_DIM2 + wdata(i,j) = i*j + ENDDO + ENDDO + + ! /* Create the dataspace */ + CALL h5screate_simple_f(2, dims, space_id, error) + CALL check("h5screate_simple_f",error,total_error) + + ! /* Create LCPL with intermediate group creation flag set */ + CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error) + CALL check("h5Pcreate_f",error,total_error) + + CALL H5Pset_create_inter_group_f(lcpl_id, TRUE, error) + CALL check("H5Pset_create_inter_group_f",error,total_error) + + ! /* Loop over using new group format */ + ! for(new_format = FALSE; new_format <= TRUE; new_format++) { + + !/* Make a FAPL that uses the "use the latest version of the format" bounds */ + CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,error) + CALL check("h5Pcreate_f",error,total_error) + + ! /* Set the "use the latest version of the format" bounds for creating objects in the file */ + + CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + +!!$ ret = H5Pset_libver_bounds(fapl_id, (new_format ? H5F_LIBVER_LATEST : H5F_LIBVER_EARLIEST), H5F_LIBVER_LATEST); + + ! /* Create a new HDF5 file */ + CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) + CALL check("H5Fcreate_f", error, total_error) + + ! /* Close the FAPL */ + CALL h5pclose_f(fapl_id, error) + CALL check("h5pclose_f",error,total_error) + + ! /* Create and commit a datatype with no name */ + CALL H5Tcopy_f( H5T_NATIVE_INTEGER, type_id, error) + CALL check("H5Tcopy",error,total_error) + + CALL H5Tcommit_anon_f(file_id, type_id, error) ! using no optional parameters + CALL check("H5Tcommit_anon",error,total_error) + + CALL H5Tcommitted_f(type_id, committed, error) + CALL check("H5Tcommitted_f",error,total_error) + CALL verifyLogical("H5Tcommitted_f", committed, .TRUE., total_error) + + ! /* Create a dataset with no name using the committed datatype*/ + CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters + CALL check("H5Dcreate_anon_f",error,total_error) + + + ! /* Verify that we can write to and read from the dataset */ + + ! /* Write the data to the dataset */ + + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, & + mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) + CALL check("h5dwrite_f", error, total_error) + + ! /* Read the data back */ + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, & + mem_space_id=H5S_ALL_F, file_space_id=H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) + CALL check("h5dread_f", error, total_error) + + ! /* Verify the data */ + DO i = 1, TEST6_DIM1 + DO j = 1, TEST6_DIM2 + CALL VERIFY("H5Dread_f",wdata(i,j),rdata(i,j),total_error) + wdata(i,j) = i*j + ENDDO + ENDDO + + ! /* Create a group with no name*/ + + CALL H5Gcreate_anon_f(file_id, group_id, error) + CALL check("H5Gcreate_anon", error, total_error) + + ! /* Link nameless datatype into nameless group */ + CALL H5Olink_f(type_id, group_id, "datatype", error, H5P_DEFAULT_F) + CALL check("H5Olink_f", error, total_error) + + ! /* Link nameless dataset into nameless group with intermediate group */ + CALL H5Olink_f(dset_id, group_id, "inter_group/dataset", error, lcpl_id, H5P_DEFAULT_F) + CALL check("H5Olink_f", error, total_error) + + ! /* Close IDs for dataset and datatype */ + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f", error, total_error) + + + ! /* Re-open datatype using new link */ + CALL H5Topen_f(group_id, "datatype", type_id, error) + CALL check("h5topen_f", error, total_error) + + ! /* Link nameless group to root group and close the group ID*/ + CALL H5Olink_f(group_id, file_id, "/group", error) + CALL check("H5Olink_f", error, total_error) + + + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f",error,total_error) + + ! /* Open dataset through root group and verify its data */ + + CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error) + CALL check("test_lcpl.h5dopen_f", error, total_error) + + ! /* Read data from dataset */ + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, rdata, dims, error, & + H5S_ALL_F, H5S_ALL_F, xfer_prp = H5P_DEFAULT_F) + CALL check("h5dread_f", error, total_error) + + ! /* Verify the data */ + DO i = 1, TEST6_DIM1 + DO j = 1, TEST6_DIM2 + CALL VERIFY("H5Dread",wdata(i,j),rdata(i,j),total_error) + ENDDO + ENDDO + ! /* Close open IDs */ + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f",error,total_error) + + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! /* Close remaining IDs */ + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5pclose_f(lcpl_id,error) + CALL check("h5pclose_f", error, total_error) + +END SUBROUTINE test_h5o_link diff --git a/fortran/test/tH5R.f90 b/fortran/test/tH5R.f90 index 687bb06..9dfc374 100644 --- a/fortran/test/tH5R.f90 +++ b/fortran/test/tH5R.f90 @@ -17,377 +17,435 @@ ! ! Testing Reference Interface functionality. ! -! The following subroutine tests h5rcreate_f, h5rdereference_f +! The following subroutine tests h5rcreate_f, h5rdereference_f, h5rget_name_f ! and H5Rget_object_type functions ! - SUBROUTINE refobjtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error - - CHARACTER(LEN=9), PARAMETER :: filename = "reference" - CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=8), PARAMETER :: dsetnamei = "INTEGERS" - CHARACTER(LEN=17), PARAMETER :: dsetnamer = "OBJECT_REFERENCES" - CHARACTER(LEN=6), PARAMETER :: groupname1 = "GROUP1" - CHARACTER(LEN=6), PARAMETER :: groupname2 = "GROUP2" - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: grp1_id ! Group identifier - INTEGER(HID_T) :: grp2_id ! Group identifier - INTEGER(HID_T) :: dset1_id ! Dataset identifier - INTEGER(HID_T) :: dsetr_id ! Dataset identifier - INTEGER(HID_T) :: type_id ! Type identifier - INTEGER(HID_T) :: space_id ! Dataspace identifier - INTEGER(HID_T) :: spacer_id ! Dataspace identifier - INTEGER :: error, obj_type - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/5/) - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr= (/4/) - INTEGER(HSIZE_T), DIMENSION(1) :: my_maxdims = (/5/) - INTEGER :: rank = 1 - INTEGER :: rankr = 1 - TYPE(hobj_ref_t_f), DIMENSION(4) :: ref - TYPE(hobj_ref_t_f), DIMENSION(4) :: ref_out - INTEGER(HSIZE_T), DIMENSION(1) :: ref_dim - INTEGER, DIMENSION(5) :: data = (/1, 2, 3, 4, 5/) - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - - - ! - !Create a new file with Default file access and - !file creation properties . - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - - ! - ! Create a group inside the file - ! - CALL h5gcreate_f(file_id, groupname1, grp1_id, error) - CALL check("h5gcreate_f",error,total_error) - - ! - ! Create a group inside the group GROUP1 - ! - CALL h5gcreate_f(grp1_id, groupname2, grp2_id, error) - CALL check("h5gcreate_f",error,total_error) - - ! - ! Create dataspaces for datasets - ! - CALL h5screate_simple_f(rank, dims, space_id, error, maxdims=my_maxdims) - CALL check("h5screate_simple_f",error,total_error) - CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - ! Create integer dataset - ! - CALL h5dcreate_f(file_id, dsetnamei, H5T_NATIVE_INTEGER, space_id, & - dset1_id, error) - CALL check("h5dcreate_f",error,total_error) - ! - ! Create dataset to store references to the objects - ! - CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_OBJ, spacer_id, & - dsetr_id, error) - CALL check("h5dcreate_f",error,total_error) - ! - ! Create a datatype and store in the file - ! - CALL h5tcopy_f(H5T_NATIVE_REAL, type_id, error) - CALL check("h5tcopy_f",error,total_error) - CALL h5tcommit_f(file_id, "MyType", type_id, error) - CALL check("h5tcommit_f",error,total_error) - - ! - ! Close dataspaces, groups and integer dataset - ! - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f",error,total_error) - CALL h5sclose_f(spacer_id, error) - CALL check("h5sclose_f",error,total_error) - CALL h5dclose_f(dset1_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5tclose_f(type_id, error) - CALL check("h5tclose_f",error,total_error) - CALL h5gclose_f(grp1_id, error) - CALL check("h5gclose_f",error,total_error) - CALL h5gclose_f(grp2_id, error) - CALL check("h5gclose_f",error,total_error) +SUBROUTINE refobjtest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=9), PARAMETER :: filename = "reference" + CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=8), PARAMETER :: dsetnamei = "INTEGERS" + CHARACTER(LEN=17), PARAMETER :: dsetnamer = "OBJECT_REFERENCES" + CHARACTER(LEN=6), PARAMETER :: groupname1 = "GROUP1" + CHARACTER(LEN=6), PARAMETER :: groupname2 = "GROUP2" + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: grp1_id ! Group identifier + INTEGER(HID_T) :: grp2_id ! Group identifier + INTEGER(HID_T) :: dset1_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER(HID_T) :: type_id ! Type identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier + INTEGER :: error, obj_type + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/5/) + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr= (/4/) + INTEGER(HSIZE_T), DIMENSION(1) :: my_maxdims = (/5/) + INTEGER :: rank = 1 + INTEGER :: rankr = 1 + TYPE(hobj_ref_t_f), DIMENSION(4) :: ref + TYPE(hobj_ref_t_f), DIMENSION(4) :: ref_out + INTEGER(HSIZE_T), DIMENSION(1) :: ref_dim + INTEGER, DIMENSION(5) :: DATA = (/1, 2, 3, 4, 5/) + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + + CHARACTER(LEN=7) :: buf ! buffer to hold the region name + CHARACTER(LEN=16) :: buf_big ! buffer bigger then needed + CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed + INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name + + ! + !Create a new file with Default file access and + !file creation properties . + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + + ! + ! Create a group inside the file + ! + CALL h5gcreate_f(file_id, groupname1, grp1_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! + ! Create a group inside the group GROUP1 + ! + CALL h5gcreate_f(grp1_id, groupname2, grp2_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! + ! Create dataspaces for datasets + ! + CALL h5screate_simple_f(rank, dims, space_id, error, maxdims=my_maxdims) + CALL check("h5screate_simple_f",error,total_error) + CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + ! Create integer dataset + ! + CALL h5dcreate_f(file_id, dsetnamei, H5T_NATIVE_INTEGER, space_id, & + dset1_id, error) + CALL check("h5dcreate_f",error,total_error) + ! + ! Create dataset to store references to the objects + ! + CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_OBJ, spacer_id, & + dsetr_id, error) + CALL check("h5dcreate_f",error,total_error) + ! + ! Create a datatype and store in the file + ! + CALL h5tcopy_f(H5T_NATIVE_REAL, type_id, error) + CALL check("h5tcopy_f",error,total_error) + CALL h5tcommit_f(file_id, "MyType", type_id, error) + CALL check("h5tcommit_f",error,total_error) + + ! + ! Close dataspaces, groups and integer dataset + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5sclose_f(spacer_id, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f",error,total_error) + CALL h5gclose_f(grp1_id, error) + CALL check("h5gclose_f",error,total_error) + CALL h5gclose_f(grp2_id, error) + CALL check("h5gclose_f",error,total_error) + + ! + ! Craete references to two groups, integer dataset and shared datatype + ! and write it to the dataset in the file + ! + CALL h5rcreate_f(file_id, groupname1, ref(1), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, "/GROUP1/GROUP2", ref(2), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, dsetnamei, ref(3), error) + CALL check("h5rcreate_f",error,total_error) + CALL h5rcreate_f(file_id, "MyType", ref(4), error) + CALL check("h5rcreate_f",error,total_error) + ref_dim(1) = SIZE(ref) + CALL h5dwrite_f(dsetr_id, H5T_STD_REF_OBJ, ref, ref_dim, error) + CALL check("h5dwrite_f",error,total_error) + + ! getting path to normal dataset in root group + + CALL H5Rget_name_f(dsetr_id, ref(1), buf, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(7,SIZE_T), total_error) + CALL VerifyString("H5Rget_name_f", buf, "/GROUP1", total_error) + + ! with buffer bigger then needed + + CALL H5Rget_name_f(dsetr_id, ref(1), buf_big, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(7,SIZE_T),total_error) + CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1", total_error) + + ! getting path to dataset in /Group1 + + CALL H5Rget_name_f(dsetr_id, ref(2), buf_big, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(14,SIZE_T),total_error) + CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/GROUP1/GROUP2", total_error) + + ! + !Close the dataset + ! + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + ! Reopen the dataset with object references + ! + CALL h5dopen_f(file_id, dsetnamer,dsetr_id,error) + CALL check("h5dopen_f",error,total_error) + ref_dim(1) = SIZE(ref_out) + CALL h5dread_f(dsetr_id, H5T_STD_REF_OBJ, ref_out, ref_dim, error) + CALL check("h5dread_f",error,total_error) + + ! + !get the third reference's type and Dereference it + ! + CALL h5rget_object_type_f(dsetr_id, ref(3), obj_type, error) + CALL check("h5rget_object_type_f",error,total_error) + IF (obj_type == H5G_DATASET_F) THEN + CALL h5rdereference_f(dsetr_id, ref(3), dset1_id, error) + CALL check("h5rdereference_f",error,total_error) + + data_dims(1) = 5 + CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, DATA, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + END IF + + ! + !get the fourth reference's type and Dereference it + ! + CALL h5rget_object_type_f(dsetr_id, ref(4), obj_type, error) + CALL check("h5rget_object_type_f",error,total_error) + IF (obj_type == H5G_TYPE_F) THEN + CALL h5rdereference_f(dsetr_id, ref(4), type_id, error) + CALL check("h5rdereference_f",error,total_error) + END IF + + ! + ! Close all objects. + ! + CALL h5dclose_f(dset1_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(type_id, error) + CALL check("h5tclose_f",error,total_error) + + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + +END SUBROUTINE refobjtest +! +! The following subroutine tests h5rget_region_f, h5rcreate_f, h5rget_name_f, +! and h5rdereference_f functionalities +! +SUBROUTINE refregtest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + CHARACTER(LEN=6), PARAMETER :: filename = "Refreg" + CHARACTER(LEN=80) :: fix_filename + CHARACTER(LEN=6), PARAMETER :: dsetnamev = "MATRIX" + CHARACTER(LEN=17), PARAMETER :: dsetnamer = "REGION_REFERENCES" + CHARACTER(LEN=7) :: buf ! buffer to hold the region name + CHARACTER(LEN=11) :: buf_big ! buffer bigger then needed + CHARACTER(LEN=4) :: buf_small ! buffer smaller then needed + INTEGER(SIZE_T) :: buf_size ! returned size of the region buffer name + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: space_id ! Dataspace identifier + INTEGER(HID_T) :: spacer_id ! Dataspace identifier + INTEGER(HID_T) :: dsetv_id ! Dataset identifier + INTEGER(HID_T) :: dsetr_id ! Dataset identifier + INTEGER :: error + TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref ! Buffers to store references + TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref_out ! + INTEGER(HSIZE_T), DIMENSION(2) :: ref_dim + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! + INTEGER(HSIZE_T), DIMENSION(2) :: start + INTEGER(HSIZE_T), DIMENSION(2) :: count + INTEGER :: rankr = 1 + INTEGER :: rank = 2 + INTEGER , DIMENSION(2,9) :: DATA + INTEGER , DIMENSION(2,9) :: data_out = 0 + INTEGER(HSIZE_T) , DIMENSION(2,3) :: coord + INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points + coord = RESHAPE((/1,1,2,7,1,9/), (/2,3/)) ! Coordinates of selected points + DATA = RESHAPE ((/1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6/), (/2,9/)) - ! - ! Craete references to two groups, integer dataset and shared datatype - ! and write it to the dataset in the file - ! - CALL h5rcreate_f(file_id, groupname1, ref(1), error) - CALL check("h5rcreate_f",error,total_error) - CALL h5rcreate_f(file_id, "/GROUP1/GROUP2", ref(2), error) - CALL check("h5rcreate_f",error,total_error) - CALL h5rcreate_f(file_id, dsetnamei, ref(3), error) - CALL check("h5rcreate_f",error,total_error) - CALL h5rcreate_f(file_id, "MyType", ref(4), error) - CALL check("h5rcreate_f",error,total_error) - ref_dim(1) = size(ref) - CALL h5dwrite_f(dsetr_id, H5T_STD_REF_OBJ, ref, ref_dim, error) - CALL check("h5dwrite_f",error,total_error) + ! + ! Initialize FORTRAN predefined datatypes. + ! + ! CALL h5init_types_f(error) + ! CALL check("h5init_types_f", error, total_error) + ! + ! Create a new file. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + ! Default file access and file creation + ! properties are used. + CALL check("h5fcreate_f", error, total_error) + ! + ! Create dataspaces: + ! + ! for dataset with references to dataset regions + ! + CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! for integer dataset + ! + CALL h5screate_simple_f(rank, dims, space_id, error) + CALL check("h5screate_simple_f", error, total_error) + ! + ! Create and write datasets: + ! + ! Integer dataset + ! + CALL h5dcreate_f(file_id, dsetnamev, H5T_NATIVE_INTEGER, space_id, & + dsetv_id, error) + CALL check("h5dcreate_f", error, total_error) + data_dims(1) = 2 + data_dims(2) = 9 + CALL h5dwrite_f(dsetv_id, H5T_NATIVE_INTEGER, DATA, data_dims, error) + CALL check("h5dwrite_f", error, total_error) - ! - !Close the dataset - ! - CALL h5dclose_f(dsetr_id, error) - CALL check("h5dclose_f",error,total_error) - ! - ! Reopen the dataset with object references - ! - CALL h5dopen_f(file_id, dsetnamer,dsetr_id,error) - CALL check("h5dopen_f",error,total_error) - ref_dim(1) = size(ref_out) - CALL h5dread_f(dsetr_id, H5T_STD_REF_OBJ, ref_out, ref_dim, error) - CALL check("h5dread_f",error,total_error) - - ! - !get the third reference's type and Dereference it - ! - CALL h5rget_object_type_f(dsetr_id, ref(3), obj_type, error) - CALL check("h5rget_object_type_f",error,total_error) - if (obj_type == H5G_DATASET_F) then - CALL h5rdereference_f(dsetr_id, ref(3), dset1_id, error) - CALL check("h5rdereference_f",error,total_error) - - data_dims(1) = 5 - CALL h5dwrite_f(dset1_id, H5T_NATIVE_INTEGER, data, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - end if + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + ! + ! Dataset with references + ! + CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_DSETREG, spacer_id, & + dsetr_id, error) + CALL check("h5dcreate_f", error, total_error) + ! + ! Create a reference to the hyperslab selection. + ! + start(1) = 0 + start(2) = 3 + COUNT(1) = 2 + COUNT(2) = 3 + CALL h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, & + start, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) + CALL check("h5rcreate_f", error, total_error) + ! + ! Create a reference to elements selection. + ! + CALL h5sselect_none_f(space_id, error) + CALL check("h5sselect_none_f", error, total_error) + CALL h5sselect_elements_f(space_id, H5S_SELECT_SET_F, rank, num_points,& + coord, error) + CALL check("h5sselect_elements_f", error, total_error) + CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(2), error) + CALL check("h5rcreate_f", error, total_error) + ! + ! Write dataset with the references. + ! + ref_dim(1) = SIZE(ref) + CALL h5dwrite_f(dsetr_id, H5T_STD_REF_DSETREG, ref, ref_dim, error) + CALL check("h5dwrite_f", error, total_error) + ! + ! Close all objects. + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5sclose_f(spacer_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) + ! + ! Reopen the file to test selections. + ! + CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error) + CALL check("h5fopen_f", error, total_error) + CALL h5dopen_f(file_id, dsetnamer, dsetr_id, error) + CALL check("h5dopen_f", error, total_error) + ! + ! Read references to the dataset regions. + ! + ref_dim(1) = SIZE(ref_out) + CALL h5dread_f(dsetr_id, H5T_STD_REF_DSETREG, ref_out, ref_dim, error) + CALL check("h5dread_f", error, total_error) - ! - !get the fourth reference's type and Dereference it - ! - CALL h5rget_object_type_f(dsetr_id, ref(4), obj_type, error) - CALL check("h5rget_object_type_f",error,total_error) - if (obj_type == H5G_TYPE_F) then - CALL h5rdereference_f(dsetr_id, ref(4), type_id, error) - CALL check("h5rdereference_f",error,total_error) - end if - ! - ! Close all objects. - ! - CALL h5dclose_f(dset1_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5tclose_f(type_id, error) - CALL check("h5tclose_f",error,total_error) + ! Get name of the dataset the first region reference points to using H5Rget_name_f + CALL H5Rget_name_f(dsetr_id, ref_out(1), buf, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(7,SIZE_T),total_error) + CALL VerifyString("H5Rget_name_f", buf, "/MATRIX", total_error) - CALL h5dclose_f(dsetr_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error,total_error) + ! Get name of the dataset the first region reference points to using H5Rget_name_f + ! buffer bigger then needed + CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_big, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(7,SIZE_T),total_error) + CALL VerifyString("H5Rget_name_f", TRIM(buf_big), "/MATRIX", total_error) - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN + ! Get name of the dataset the first region reference points to using H5Rget_name_f + ! buffer smaller then needed + CALL H5Rget_name_f(dsetr_id, ref_out(1), buf_small, error, buf_size ) + CALL check("H5Rget_name_f", error, total_error) + CALL VERIFY("H5Rget_name_f", buf_size,INT(7,SIZE_T),total_error) + CALL VerifyString("H5Rget_name_f", TRIM(buf_small), "/MAT", total_error) - END SUBROUTINE refobjtest -! -! The following subroutine tests h5rget_region_f, h5rcreate_f -! and h5rdereference_f functionalities -! - SUBROUTINE refregtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(OUT) :: total_error + ! + ! Dereference the first reference. + ! + CALL H5rdereference_f(dsetr_id, ref_out(1), dsetv_id, error) + CALL check("h5rdereference_f", error, total_error) + CALL H5rget_region_f(dsetr_id, ref_out(1), space_id, error) + CALL check("h5rget_region_f", error, total_error) - CHARACTER(LEN=6), PARAMETER :: filename = "Refreg" - CHARACTER(LEN=80) :: fix_filename - CHARACTER(LEN=6), PARAMETER :: dsetnamev = "MATRIX" - CHARACTER(LEN=17), PARAMETER :: dsetnamer = "REGION_REFERENCES" + ! Get name of the dataset the second region reference points to using H5Rget_name_f + CALL H5Rget_name_f(dsetr_id, ref_out(2), buf, error) ! no optional size + CALL check("H5Rget_name_f", error, total_error) + CALL VerifyString("H5Rget_name_f", buf, "/MATRIX", total_error) - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: space_id ! Dataspace identifier - INTEGER(HID_T) :: spacer_id ! Dataspace identifier - INTEGER(HID_T) :: dsetv_id ! Dataset identifier - INTEGER(HID_T) :: dsetr_id ! Dataset identifier - INTEGER :: error - TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref ! Buffers to store references - TYPE(hdset_reg_ref_t_f) , DIMENSION(2) :: ref_out ! - INTEGER(HSIZE_T), DIMENSION(2) :: ref_dim - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/2,9/) ! Datasets dimensions - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr = (/2/) ! - INTEGER(HSIZE_T), DIMENSION(2) :: start - INTEGER(HSIZE_T), DIMENSION(2) :: count - INTEGER :: rankr = 1 - INTEGER :: rank = 2 - INTEGER , DIMENSION(2,9) :: data - INTEGER , DIMENSION(2,9) :: data_out = 0 - INTEGER(HSIZE_T) , DIMENSION(2,3) :: coord - INTEGER(SIZE_T) ::num_points = 3 ! Number of selected points - INTEGER :: i, j - coord = reshape((/1,1,2,7,1,9/), (/2,3/)) ! Coordinates of selected points - data = reshape ((/1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6/), (/2,9/)) - ! - ! Initialize FORTRAN predefined datatypes. - ! -! CALL h5init_types_f(error) -! CALL check("h5init_types_f", error, total_error) - ! - ! Create a new file. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - ! Default file access and file creation - ! properties are used. - CALL check("h5fcreate_f", error, total_error) - ! - ! Create dataspaces: - ! - ! for dataset with references to dataset regions - ! - CALL h5screate_simple_f(rankr, dimsr, spacer_id, error) - CALL check("h5screate_simple_f", error, total_error) - ! - ! for integer dataset - ! - CALL h5screate_simple_f(rank, dims, space_id, error) - CALL check("h5screate_simple_f", error, total_error) - ! - ! Create and write datasets: - ! - ! Integer dataset - ! - CALL h5dcreate_f(file_id, dsetnamev, H5T_NATIVE_INTEGER, space_id, & - dsetv_id, error) - CALL check("h5dcreate_f", error, total_error) - data_dims(1) = 2 - data_dims(2) = 9 - CALL h5dwrite_f(dsetv_id, H5T_NATIVE_INTEGER, data, data_dims, error) - CALL check("h5dwrite_f", error, total_error) + ! + ! Read selected data from the dataset. + ! + data_dims(1) = 2 + data_dims(2) = 9 + CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & + mem_space_id = space_id, file_space_id = space_id) + CALL check("h5dread_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + data_out = 0 + ! + ! Dereference the second reference. + ! + CALL H5rdereference_f(dsetr_id, ref_out(2), dsetv_id, error) + CALL check("h5rdereference_f", error, total_error) - CALL h5dclose_f(dsetv_id, error) - CALL check("h5dclose_f", error, total_error) - ! - ! Dataset with references - ! - CALL h5dcreate_f(file_id, dsetnamer, H5T_STD_REF_DSETREG, spacer_id, & - dsetr_id, error) - CALL check("h5dcreate_f", error, total_error) - ! - ! Create a reference to the hyperslab selection. - ! - start(1) = 0 - start(2) = 3 - count(1) = 2 - count(2) = 3 - CALL h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, & - start, count, error) - CALL check("h5sselect_hyperslab_f", error, total_error) - CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(1), error) - CALL check("h5rcreate_f", error, total_error) - ! - ! Create a reference to elements selection. - ! - CALL h5sselect_none_f(space_id, error) - CALL check("h5sselect_none_f", error, total_error) - CALL h5sselect_elements_f(space_id, H5S_SELECT_SET_F, rank, num_points,& - coord, error) - CALL check("h5sselect_elements_f", error, total_error) - CALL h5rcreate_f(file_id, dsetnamev, space_id, ref(2), error) - CALL check("h5rcreate_f", error, total_error) - ! - ! Write dataset with the references. - ! - ref_dim(1) = size(ref) - CALL h5dwrite_f(dsetr_id, H5T_STD_REF_DSETREG, ref, ref_dim, error) - CALL check("h5dwrite_f", error, total_error) - ! - ! Close all objects. - ! - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - CALL h5sclose_f(spacer_id, error) - CALL check("h5sclose_f", error, total_error) - CALL h5dclose_f(dsetr_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) - ! - ! Reopen the file to test selections. - ! - CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error) - CALL check("h5fopen_f", error, total_error) - CALL h5dopen_f(file_id, dsetnamer, dsetr_id, error) - CALL check("h5dopen_f", error, total_error) - ! - ! Read references to the dataset regions. - ! - ref_dim(1) = size(ref_out) - CALL h5dread_f(dsetr_id, H5T_STD_REF_DSETREG, ref_out, ref_dim, error) - CALL check("h5dread_f", error, total_error) - ! - ! Dereference the first reference. - ! - CALL H5rdereference_f(dsetr_id, ref_out(1), dsetv_id, error) - CALL check("h5rdereference_f", error, total_error) - CALL H5rget_region_f(dsetr_id, ref_out(1), space_id, error) - CALL check("h5rget_region_f", error, total_error) - ! - ! Read selected data from the dataset. - ! - data_dims(1) = 2 - data_dims(2) = 9 - CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & - mem_space_id = space_id, file_space_id = space_id) - CALL check("h5dread_f", error, total_error) - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - CALL h5dclose_f(dsetv_id, error) - CALL check("h5dclose_f", error, total_error) - data_out = 0 - ! - ! Dereference the second reference. - ! - CALL H5rdereference_f(dsetr_id, ref_out(2), dsetv_id, error) - CALL check("h5rdereference_f", error, total_error) - - CALL H5rget_region_f(dsetr_id, ref_out(2), space_id, error) - CALL check("h5rget_region_f", error, total_error) - ! - ! Read selected data from the dataset. - ! - CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & - mem_space_id = space_id, file_space_id = space_id) - CALL check("h5dread_f", error, total_error) - ! - ! Close all objects - ! - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - CALL h5dclose_f(dsetv_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5dclose_f(dsetr_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) + CALL H5rget_region_f(dsetr_id, ref_out(2), space_id, error) + CALL check("h5rget_region_f", error, total_error) + ! + ! Read selected data from the dataset. + ! + CALL h5dread_f(dsetv_id, H5T_NATIVE_INTEGER, data_out, data_dims, error, & + mem_space_id = space_id, file_space_id = space_id) + CALL check("h5dread_f", error, total_error) + ! + ! Close all objects + ! + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + CALL h5dclose_f(dsetv_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5dclose_f(dsetr_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN - END SUBROUTINE refregtest +END SUBROUTINE refregtest diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90 index 2f77db9..a004ba7 100644 --- a/fortran/test/tH5Sselect.f90 +++ b/fortran/test/tH5Sselect.f90 @@ -52,10 +52,6 @@ ! INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/) - ! - !to get Dataset dimensions - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims_out ! !Dataset dimensions @@ -103,21 +99,18 @@ ! INTEGER :: memrank = 3 - ! - !integer to get the dataspace rank from dataset - ! - INTEGER :: rank + ! !general purpose integer ! - INTEGER :: i, j, k + INTEGER :: i, j ! !flag to check operation success ! - INTEGER :: error, error_n + INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims @@ -397,8 +390,7 @@ ! !flag to check operation success ! - INTEGER :: error - LOGICAL :: status + INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims @@ -720,8 +712,7 @@ INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier - INTEGER(HID_T) :: dataspace ! Dataspace identifier - INTEGER(HID_T) :: memspace ! memspace identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier ! !Dataset dimensions @@ -763,10 +754,6 @@ ! INTEGER(HSIZE_T), DIMENSION(RANK, NUMPS) :: coord - ! - !Size of the hyperslab in memory - ! - INTEGER(HSIZE_T), DIMENSION(3) :: count_out = (/3,4,1/) ! !Number of hyperslabs selected in the current dataspace @@ -802,19 +789,9 @@ INTEGER, DIMENSION(5,6) :: data ! - !output buffer - ! - INTEGER, DIMENSION(7,7,3) :: data_out - - ! - !general purpose integer - ! - INTEGER :: i, j, k - - ! !flag to check operation success ! - INTEGER :: error, error_n + INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims ! diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 3bbb974..4857a2b 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -27,7 +27,7 @@ ! The following H5T interface functions are tested: ! h5tcopy_f, h5tset(get)_size_f, h5tcreate_f, h5tinsert_f, h5tclose_f, ! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f, -! h5tequal_f, h5tinsert_array_f, h5tcommit_f +! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f USE HDF5 ! This module contains all necessary modules @@ -88,6 +88,12 @@ INTEGER(SIZE_T) :: sizechar INTEGER(HSIZE_T), DIMENSION(1) :: data_dims LOGICAL :: flag = .TRUE. + + CHARACTER(LEN=1024) :: cmpd_buf + INTEGER(size_t) :: cmpd_buf_size=0 + INTEGER(hid_t) :: decoded_sid1 + INTEGER :: decoded_tid1 + data_dims(1) = dimsize ! ! Initialize data buffer. @@ -176,7 +182,36 @@ ! offset = offset + type_sized ! Offset of the last member is 14 CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) + +!!$ !/*----------------------------------------------------------------------- +!!$ ! * Test encoding and decoding compound datatypes +!!$ ! *----------------------------------------------------------------------- +!!$ !*/ +!!$ ! /* Encode compound type in a buffer */ +!!$ +!!$ ! First find the buffer size +!!$ +!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) +!!$ CALL check("H5Tencode_f", error, total_error) +!!$ +!!$ ! /* Try decoding bogus buffer */ +!!$ +!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) +!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error) +!!$ +!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) +!!$ CALL check("H5Tencode_f", error, total_error) +!!$ +!!$ ! /* Decode from the compound buffer and return an object handle */ +!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) +!!$ CALL check("H5Tdecode_f", error, total_error) +!!$ +!!$ ! /* Verify that the datatype was copied exactly */ +!!$ +!!$ CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) +!!$ CALL check("H5Tequal_f", error, total_error) +!!$ CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) ! ! Create the dataset with compound datatype. @@ -485,7 +520,33 @@ endif enddo ! + ! *----------------------------------------------------------------------- + ! * Test encoding and decoding compound datatypes + ! *----------------------------------------------------------------------- + ! + ! /* Encode compound type in a buffer */ + ! -- First find the buffer size + + CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) + CALL check("H5Tencode_f", error, total_error) + ! /* Try decoding bogus buffer */ + + CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) + CALL VERIFY("H5Tdecode_f", error, -1, total_error) + + CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error) + CALL check("H5Tencode_f", error, total_error) + + ! /* Decode from the compound buffer and return an object handle */ + CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error) + CALL check("H5Tdecode_f", error, total_error) + + ! /* Verify that the datatype was copied exactly */ + + CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error) + CALL check("H5Tequal_f", error, total_error) + CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error) ! ! Close all open objects. ! diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90 index 998fef5..13f2af1 100644 --- a/fortran/test/tH5VL.f90 +++ b/fortran/test/tH5VL.f90 @@ -364,7 +364,6 @@ INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier - INTEGER(HID_T) :: vltype_id ! Datatype identifier INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/4/) ! Dataset dimensions @@ -374,10 +373,9 @@ CHARACTER(LEN=10), DIMENSION(4) :: string_data ! Array of strings CHARACTER(LEN=10), DIMENSION(4) :: string_data_out ! Data buffers - CHARACTER(LEN=10) :: tmp_str INTEGER :: error ! Error flag - INTEGER :: i, j !general purpose integers + INTEGER :: i !general purpose integers INTEGER(HSIZE_T), DIMENSION(2) :: data_dims = (/10,4/) INTEGER(HID_T) :: vl_type_id LOGICAL :: vl_flag diff --git a/fortran/test/tH5Z.f90 b/fortran/test/tH5Z.f90 index 2a71961..ea567a2 100644 --- a/fortran/test/tH5Z.f90 +++ b/fortran/test/tH5Z.f90 @@ -22,7 +22,7 @@ IMPLICIT NONE LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(OUT) :: total_error - LOGICAL :: status, status1 + LOGICAL :: status INTEGER(HID_T) :: crtpr_id, xfer_id INTEGER :: nfilters INTEGER :: error diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90 index 673a8e2..eb033b6 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -23,30 +23,60 @@ !DEC$attributes dllexport :: check !DEC$endif - SUBROUTINE check(string,error,total_error) - CHARACTER(LEN=*) :: string - INTEGER :: error, total_error - if (error .lt. 0) then - total_error=total_error+1 - write(*,*) string, " failed" - endif - RETURN - END SUBROUTINE check - +SUBROUTINE check(string,error,total_error) + CHARACTER(LEN=*) :: string + INTEGER :: error, total_error + IF (error .LT. 0) THEN + total_error=total_error+1 + WRITE(*,*) string, " FAILED" + ENDIF + RETURN +END SUBROUTINE check !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: verify !DEC$endif - SUBROUTINE verify(string,value,correct_value,total_error) - CHARACTER(LEN=*) :: string - INTEGER :: value, correct_value, total_error - if (value .ne. correct_value) then - total_error=total_error+1 - write(*,*) string - endif - RETURN - END SUBROUTINE verify +SUBROUTINE VERIFY(string,value,correct_value,total_error) + CHARACTER(LEN=*) :: string + INTEGER :: value, correct_value, total_error + IF (value .NE. correct_value) THEN + total_error=total_error+1 + WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string + ENDIF + RETURN +END SUBROUTINE verify + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: verifyLogical +!DEC$endif +SUBROUTINE verifyLogical(string,value,correct_value,total_error) + CHARACTER(LEN=*) :: string + LOGICAL :: value, correct_value + INTEGER :: total_error + IF (value .NEQV. correct_value) THEN + total_error = total_error + 1 + WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string + ENDIF + RETURN +END SUBROUTINE verifyLogical + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_DLL) +!DEC$attributes dllexport :: verifyLogical +!DEC$endif +SUBROUTINE verifyString(string, value,correct_value,total_error) + CHARACTER(LEN=*) :: string + CHARACTER(LEN=*) :: value, correct_value + INTEGER :: total_error + IF (TRIM(value) .NE. TRIM(correct_value)) THEN + total_error = total_error + 1 + WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string + ENDIF + RETURN +END SUBROUTINE verifyString + !---------------------------------------------------------------------- ! Name: h5_fixname_f @@ -68,46 +98,46 @@ ! ! !---------------------------------------------------------------------- - SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) +SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5_fixname_f !DEC$endif - USE H5GLOBAL - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name - INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - - INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string - INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string + USE H5GLOBAL + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name + CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list + + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string + INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string ! INTEGER(HID_T) :: fapl_default - INTERFACE - INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, & - full_name, full_namelen) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name - !DEC$ATTRIBUTES reference :: full_name - CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER(SIZE_T) :: base_namelen - INTEGER(HID_T), INTENT(IN) :: fapl - CHARACTER(LEN=*), INTENT(IN) :: full_name - INTEGER(SIZE_T) :: full_namelen - END FUNCTION h5_fixname_c - END INTERFACE - - base_namelen = LEN(base_name) - full_namelen = LEN(full_name) - hdferr = h5_fixname_c(base_name, base_namelen, fapl, & - full_name, full_namelen) - - END SUBROUTINE h5_fixname_f + INTERFACE + INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, & + full_name, full_namelen) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: base_name + !DEC$ATTRIBUTES reference :: full_name + CHARACTER(LEN=*), INTENT(IN) :: base_name + INTEGER(SIZE_T) :: base_namelen + INTEGER(HID_T), INTENT(IN) :: fapl + CHARACTER(LEN=*), INTENT(IN) :: full_name + INTEGER(SIZE_T) :: full_namelen + END FUNCTION h5_fixname_c + END INTERFACE + + base_namelen = LEN(base_name) + full_namelen = LEN(full_name) + hdferr = h5_fixname_c(base_name, base_namelen, fapl, & + full_name, full_namelen) + +END SUBROUTINE h5_fixname_f !---------------------------------------------------------------------- ! Name: h5_cleanup_f @@ -128,37 +158,37 @@ ! ! !---------------------------------------------------------------------- - SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr) +SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5_cleanup_f !DEC$endif - USE H5GLOBAL - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - - INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string - - INTERFACE - INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name - CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER(SIZE_T) :: base_namelen - INTEGER(HID_T), INTENT(IN) :: fapl - END FUNCTION h5_cleanup_c - END INTERFACE - - base_namelen = LEN(base_name) - hdferr = h5_cleanup_c(base_name, base_namelen, fapl) - - END SUBROUTINE h5_cleanup_f + USE H5GLOBAL + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list + + INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string + + INTERFACE + INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c + !DEC$ ENDIF + !DEC$ATTRIBUTES reference :: base_name + CHARACTER(LEN=*), INTENT(IN) :: base_name + INTEGER(SIZE_T) :: base_namelen + INTEGER(HID_T), INTENT(IN) :: fapl + END FUNCTION h5_cleanup_c + END INTERFACE + + base_namelen = LEN(base_name) + hdferr = h5_cleanup_c(base_name, base_namelen, fapl) + +END SUBROUTINE h5_cleanup_f !---------------------------------------------------------------------- ! Name: h5_exit_f @@ -180,25 +210,25 @@ ! ! !---------------------------------------------------------------------- - SUBROUTINE h5_exit_f(status) +SUBROUTINE h5_exit_f(status) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5_exit_f !DEC$endif - IMPLICIT NONE - INTEGER, INTENT(IN) :: status ! Return code - - INTERFACE - SUBROUTINE h5_exit_c(status) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c - !DEC$ ENDIF - INTEGER, INTENT(IN) :: status - END SUBROUTINE h5_exit_c - END INTERFACE - - CALL h5_exit_c(status) - - END SUBROUTINE h5_exit_f + IMPLICIT NONE + INTEGER, INTENT(IN) :: status ! Return code + + INTERFACE + SUBROUTINE h5_exit_c(status) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c + !DEC$ ENDIF + INTEGER, INTENT(IN) :: status + END SUBROUTINE h5_exit_c + END INTERFACE + + CALL h5_exit_c(status) + +END SUBROUTINE h5_exit_f |