summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2008-04-30 19:51:13 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2008-04-30 19:51:13 (GMT)
commitaec106e324ce20e5efb725c25a6a333c7970127b (patch)
tree234df369115a46b08037c5f385061cf58823e497 /fortran
parent5773fd34bc5adf59b4530d95ac9f0c0585902803 (diff)
downloadhdf5-aec106e324ce20e5efb725c25a6a333c7970127b.zip
hdf5-aec106e324ce20e5efb725c25a6a333c7970127b.tar.gz
hdf5-aec106e324ce20e5efb725c25a6a333c7970127b.tar.bz2
[svn-r14903] Undoing change committed in r14902.
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Af.c800
-rw-r--r--fortran/src/H5Aff.f902396
-rw-r--r--fortran/src/H5Df.c61
-rw-r--r--fortran/src/H5Dff.f90452
-rw-r--r--fortran/src/H5Ff.c2
-rw-r--r--fortran/src/H5Fff.f904
-rw-r--r--fortran/src/H5Gf.c241
-rw-r--r--fortran/src/H5Gff.f90636
-rw-r--r--fortran/src/H5If.c12
-rw-r--r--fortran/src/H5Lf.c817
-rw-r--r--fortran/src/H5Lff.f901323
-rw-r--r--fortran/src/H5Of.c99
-rw-r--r--fortran/src/H5Off.f90163
-rw-r--r--fortran/src/H5Pf.c1034
-rw-r--r--fortran/src/H5Pff.f901794
-rw-r--r--fortran/src/H5Rf.c99
-rw-r--r--fortran/src/H5Rff.f90153
-rw-r--r--fortran/src/H5Sf.c124
-rw-r--r--fortran/src/H5Sff.f90168
-rw-r--r--fortran/src/H5Tf.c214
-rw-r--r--fortran/src/H5Tff.f90519
-rw-r--r--fortran/src/H5_f.c385
-rw-r--r--fortran/src/H5_ff.f90366
-rw-r--r--fortran/src/H5f90global.f90272
-rw-r--r--fortran/src/H5f90proto.h253
-rw-r--r--fortran/src/HDF5.f9033
-rw-r--r--fortran/src/HDF5mpio.f902
-rw-r--r--fortran/src/Makefile.am10
-rw-r--r--fortran/src/Makefile.in29
-rw-r--r--fortran/src/README_DEVELOPEMENT36
-rw-r--r--fortran/test/Makefile.am14
-rw-r--r--fortran/test/Makefile.in63
-rw-r--r--fortran/test/fflush1.f908
-rw-r--r--fortran/test/fflush2.f9011
-rw-r--r--fortran/test/fortranlib_test_1_8.f90966
-rw-r--r--fortran/test/tH5A.f90111
-rw-r--r--fortran/test/tH5A_1_8.f903777
-rw-r--r--fortran/test/tH5F.f902
-rw-r--r--fortran/test/tH5G.f905
-rw-r--r--fortran/test/tH5G_1_8.f902823
-rw-r--r--fortran/test/tH5O.f90208
-rw-r--r--fortran/test/tH5R.f90768
-rw-r--r--fortran/test/tH5Sselect.f9035
-rw-r--r--fortran/test/tH5T.f9065
-rw-r--r--fortran/test/tH5VL.f904
-rw-r--r--fortran/test/tH5Z.f902
-rw-r--r--fortran/test/tf.f90218
47 files changed, 1976 insertions, 19601 deletions
diff --git a/fortran/src/H5Af.c b/fortran/src/H5Af.c
index 5fdc27e..0be225b 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 *aapl, hid_t_f *attr_id)
+ hid_t_f *space_id, hid_t_f *crt_prp, 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, (hid_t)*aapl)) < 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, H5P_DEFAULT)) < 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,801 +969,27 @@ done:
int_f
nh5aget_name_c(hid_t_f *attr_id, size_t_f *bufsize, _fcd buf)
{
- 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 */
+ char *c_buf=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_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 */
-
- /*
- * 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((*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
+ * Allocate buffer to hold name of an attribute
*/
- 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;
+ if ((c_buf = HDmalloc((size_t)*bufsize +1)) == NULL)
+ HGOTO_DONE(FAIL);
/*
- * Call H5Aget_name_by_idx function.
+ * Call H5Aget_name 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;
+ if ((ret_value = (int_f)H5Aget_name((hid_t)*attr_id, (size_t)*bufsize, c_buf)) < 0)
+ HGOTO_DONE(FAIL);
/*
* Convert C name to FORTRAN and place it in the given buffer
*/
- 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);
+ HD5packFstring(c_buf, _fcdtocp(buf), (size_t)*bufsize);
done:
- if(c_old_attr_name)
- HDfree(c_old_attr_name);
- if(c_new_attr_name)
- HDfree(c_new_attr_name);
- return ret_value;
+ if(c_buf) HDfree(c_buf);
+ return ret_value;
}
diff --git a/fortran/src/H5Aff.f90 b/fortran/src/H5Aff.f90
index 4a97a11..d6f1b6f 100644
--- a/fortran/src/H5Aff.f90
+++ b/fortran/src/H5Aff.f90
@@ -16,94 +16,96 @@
!
! 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
@@ -112,7 +114,7 @@ CONTAINS
! or named datatype
!
! Inputs:
-! loc_id - identifier of an object (group, dataset,
+! obj_id - identifier of an object (group, dataset,
! or named datatype) attribute is attached to
! name - attribute name
! type_id - attribute datatype identifier
@@ -124,8 +126,7 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! acpl_id - Attribute creation property list identifier
-! appl_id - Attribute access property list identifier
+! creation_prp - creation property list identifier
!
! Programmer: Elena Pourmal
! August 12, 1999
@@ -135,60 +136,53 @@ CONTAINS
! port). February 27, 2001
!
!----------------------------------------------------------------------
- SUBROUTINE h5acreate_f(loc_id, name, type_id, space_id, attr_id, &
- hdferr, acpl_id, aapl_id )
+ SUBROUTINE h5acreate_f(obj_id, name, type_id, space_id, attr_id, &
+ hdferr, creation_prp)
!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) :: 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
+ 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
! INTEGER, EXTERNAL :: h5acreate_c
! MS FORTRAN needs explicit interface for C functions called here.
!
- 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
+ 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
!----------------------------------------------------------------------
@@ -217,38 +211,38 @@ CONTAINS
!
!----------------------------------------------------------------------
- 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
!----------------------------------------------------------------------
@@ -277,380 +271,386 @@ CONTAINS
!
!----------------------------------------------------------------------
- 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
-
- hdferr = h5awrite_integer_1_c(attr_id, memtype_id, buf, dims)
+ 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
- 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,11 +1463,6 @@ CONTAINS
! 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.
@@ -1483,7 +1478,7 @@ CONTAINS
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(INOUT) :: buf ! Attribute data
+ INTEGER, INTENT(OUT) :: buf ! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_integer_s_c
@@ -1495,12 +1490,13 @@ CONTAINS
!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(INOUT)::buf
+ INTEGER, INTENT(OUT)::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
@@ -1514,7 +1510,8 @@ CONTAINS
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(INOUT), DIMENSION(dims(1)) :: buf
+ INTEGER, INTENT(OUT), &
+ DIMENSION(dims(1)) :: buf
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_integer_1_c
@@ -1529,7 +1526,8 @@ CONTAINS
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(INOUT), DIMENSION(dims(1)) :: buf
+ INTEGER, INTENT(OUT), &
+ DIMENSION(dims(1)) :: buf
END FUNCTION h5aread_integer_1_c
END INTERFACE
@@ -1547,7 +1545,8 @@ CONTAINS
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(INOUT),DIMENSION(dims(1),dims(2)) :: buf
+ INTEGER, INTENT(OUT), &
+ DIMENSION(dims(1),dims(2)) :: buf
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_integer_2_c
@@ -1562,7 +1561,8 @@ CONTAINS
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(INOUT), DIMENSION(dims(1),dims(2)) :: buf
+ INTEGER, INTENT(OUT), &
+ DIMENSION(dims(1),dims(2)) :: buf
END FUNCTION h5aread_integer_2_c
END INTERFACE
@@ -1580,8 +1580,8 @@ CONTAINS
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(INOUT), &
- DIMENSION(dims(1),dims(2),dims(3)) :: buf
+ INTEGER, INTENT(OUT), &
+ DIMENSION(dims(1),dims(2),dims(3)) :: buf
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_integer_3_c
@@ -1596,7 +1596,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
END FUNCTION h5aread_integer_3_c
END INTERFACE
@@ -1615,7 +1615,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1632,7 +1632,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
END FUNCTION h5aread_integer_4_c
END INTERFACE
@@ -1651,7 +1651,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1668,7 +1668,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
END FUNCTION h5aread_integer_5_c
END INTERFACE
@@ -1687,7 +1687,7 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ INTEGER, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT) :: buf ! Attribute data
+ REAL, INTENT(OUT) :: buf ! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_real_s_c
@@ -1774,7 +1774,7 @@ CONTAINS
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(INOUT)::buf
+ REAL, INTENT(OUT)::buf
END FUNCTION h5aread_real_s_c
END INTERFACE
@@ -1791,7 +1791,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1808,7 +1808,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1)) :: buf
END FUNCTION h5aread_real_1_c
END INTERFACE
@@ -1827,7 +1827,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1844,7 +1844,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2)) :: buf
END FUNCTION h5aread_real_2_c
END INTERFACE
@@ -1863,7 +1863,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1880,7 +1880,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
END FUNCTION h5aread_real_3_c
END INTERFACE
@@ -1899,7 +1899,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1916,7 +1916,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
END FUNCTION h5aread_real_4_c
END INTERFACE
@@ -1935,7 +1935,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -1952,7 +1952,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
END FUNCTION h5aread_real_5_c
END INTERFACE
@@ -1971,7 +1971,7 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ REAL, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT) :: buf ! Attribute data
+ DOUBLE PRECISION, INTENT(OUT) :: buf ! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5aread_double_s_c
@@ -2058,7 +2058,7 @@ CONTAINS
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(INOUT)::buf
+ DOUBLE PRECISION, INTENT(OUT)::buf
END FUNCTION h5aread_double_s_c
END INTERFACE
@@ -2075,7 +2075,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2092,7 +2092,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1)) :: buf
END FUNCTION h5aread_double_1_c
END INTERFACE
@@ -2111,7 +2111,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2128,7 +2128,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2)) :: buf
END FUNCTION h5aread_double_2_c
END INTERFACE
@@ -2147,7 +2147,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2164,7 +2164,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
END FUNCTION h5aread_double_3_c
END INTERFACE
@@ -2183,7 +2183,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2200,7 +2200,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
END FUNCTION h5aread_double_4_c
END INTERFACE
@@ -2219,7 +2219,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2236,7 +2236,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
END FUNCTION h5aread_double_5_c
END INTERFACE
@@ -2255,7 +2255,7 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ DOUBLE PRECISION, INTENT(OUT), &
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 @@ CONTAINS
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(INOUT) :: buf
+ CHARACTER(LEN=*), INTENT(OUT) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2344,7 +2344,7 @@ CONTAINS
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(INOUT) :: buf
+ CHARACTER(LEN=*) :: buf
END FUNCTION h5areadc_s_c
END INTERFACE
@@ -2361,7 +2361,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2379,8 +2379,8 @@ CONTAINS
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(INOUT), &
- DIMENSION(dims(1)) :: buf
+ CHARACTER(LEN=*), INTENT(OUT), &
+ DIMENSION(dims(1)) :: buf
END FUNCTION h5areadc_1_c
END INTERFACE
@@ -2398,8 +2398,8 @@ CONTAINS
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(INOUT), &
- DIMENSION(dims(1),dims(2)) :: buf
+ CHARACTER(LEN=*), INTENT(OUT), &
+ DIMENSION(dims(1),dims(2)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2416,7 +2416,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2)) :: buf
END FUNCTION h5areadc_2_c
END INTERFACE
@@ -2435,7 +2435,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2453,7 +2453,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3)) :: buf
END FUNCTION h5areadc_3_c
END INTERFACE
@@ -2472,7 +2472,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2490,7 +2490,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4)) :: buf
END FUNCTION h5areadc_4_c
END INTERFACE
@@ -2509,7 +2509,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
! Attribute data
INTEGER, INTENT(OUT) :: hdferr ! Error code
@@ -2527,7 +2527,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5)) :: buf
END FUNCTION h5areadc_5_c
END INTERFACE
@@ -2546,7 +2546,7 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
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 @@ CONTAINS
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(INOUT), &
+ CHARACTER(LEN=*), INTENT(OUT), &
DIMENSION(dims(1),dims(2),dims(3),dims(4),dims(5),dims(6),dims(7)) :: buf
END FUNCTION h5areadc_7_c
END INTERFACE
@@ -2740,147 +2740,37 @@ CONTAINS
!----------------------------------------------------------------------
- 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
-
+ 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
! 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
-
- 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
-!----------------------------------------------------------------------
+ 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
- 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
+ hdferr = h5aget_name_c(attr_id, size, buf)
+ END SUBROUTINE h5aget_name_f
!----------------------------------------------------------------------
@@ -2908,33 +2798,33 @@ CONTAINS
!
!----------------------------------------------------------------------
- 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
@@ -2962,36 +2852,36 @@ CONTAINS
!
!----------------------------------------------------------------------
- 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
@@ -3017,1177 +2907,29 @@ CONTAINS
!
!----------------------------------------------------------------------
- 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
-
- 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 :: 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), INTENT(IN) :: attr_namelen
- INTEGER(HID_T), INTENT(OUT) :: 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
+ 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
+ END MODULE H5A
diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c
index 49f8266..929a056 100644
--- a/fortran/src/H5Df.c
+++ b/fortran/src/H5Df.c
@@ -30,13 +30,10 @@
* Returns: 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Wednesday, August 4, 1999
- * Modifications:
- * - Added optional parameters introduced in version 1.8
- * February, 2008
+ * Modifications:
*---------------------------------------------------------------------------*/
int_f
-nh5dcreate_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *space_id,
- hid_t_f *lcpl_id, hid_t_f *dcpl_id, hid_t_f *dapl_id, 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 *crt_prp, hid_t_f *dset_id)
{
char *c_name = NULL;
hid_t c_dset_id;
@@ -51,8 +48,7 @@ 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,
- (hid_t)*lcpl_id, (hid_t)*dcpl_id, (hid_t)*dapl_id)) < 0)
+ 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)
goto DONE;
*dset_id = (hid_t_f)c_dset_id;
@@ -70,15 +66,14 @@ 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: Added 1.8 parameter: dapl_id
+ * Modifications:
*---------------------------------------------------------------------------*/
int_f
-nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f *dset_id)
+nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dset_id)
{
char *c_name = NULL;
hid_t c_dset_id;
@@ -93,7 +88,7 @@ nh5dopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *dapl_id, hid_t_f
/*
* Call H5Dopen2 function.
*/
- if((c_dset_id = H5Dopen2((hid_t)*loc_id, c_name, (hid_t)*dapl_id)) < 0)
+ if((c_dset_id = H5Dopen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0)
goto DONE;
*dset_id = (hid_t_f)c_dset_id;
@@ -1262,21 +1257,18 @@ nh5dget_create_plist_c ( hid_t_f *dset_id , hid_t_f *plist_id)
/*----------------------------------------------------------------------------
- * Name: h5dset_extent_c
+ * Name: h5dextend_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: Changed name from the now obsolete h5dextend
- * to h5dset_extent in order to match new fortran interface.
- * -MSB- March 14, 2008
+ * Modifications:
*---------------------------------------------------------------------------*/
int_f
-nh5dset_extent_c ( hid_t_f *dset_id , hsize_t_f *dims)
+nh5dextend_c ( hid_t_f *dset_id , hsize_t_f *dims)
{
hid_t c_space_id;
hsize_t c_dims[H5S_MAX_RANK];
@@ -1954,39 +1946,4 @@ 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 a94339f..34bcdf4 100644
--- a/fortran/src/H5Dff.f90
+++ b/fortran/src/H5Dff.f90
@@ -16,115 +16,111 @@
!
! 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
-
- INTERFACE h5dextend_f
- MODULE PROCEDURE h5dset_extent_f
- 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
+
+
+ CONTAINS
!----------------------------------------------------------------------
! Name: h5dcreate_f
@@ -142,86 +138,64 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! creation_prp - Dataset creation property list
-! lcpl_id - Link creation property list
-! dapl_id - Dataset access property list
+! createion_prp - dataset creation 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). February 28, 2001
-!
-! - Added version's 1.8 new optional parameters
-! February, 2008
+! Modifications: Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). February 28, 2001
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, &
- hdferr, dcpl_id, lcpl_id, dapl_id)
-
+ SUBROUTINE h5dcreate_f(loc_id, name, type_id, space_id, dset_id, &
+ hdferr, creation_prp)
!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) :: 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
+ 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
+! 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, 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
+ 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
!----------------------------------------------------------------------
! Name: h5dopen_f
@@ -237,22 +211,19 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! dapl_id - Dataset access property list
+! NONE
!
! 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
-!
-! -Added 1.8 (optional) parameter dapl_id
-! February, 2008, M.S. Breitenfeld
+! Modifications: Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). February 28, 2001
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5dopen_f(loc_id, name, dset_id, hdferr, dapl_id)
+ SUBROUTINE h5dopen_f(loc_id, name, dset_id, hdferr)
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5dopen_f
@@ -260,18 +231,15 @@ CONTAINS
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, dapl_id_default, dset_id)
+ INTEGER FUNCTION h5dopen_c(loc_id, name, namelen, dset_id)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DOPEN_C'::h5dopen_c
@@ -280,16 +248,12 @@ CONTAINS
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, dapl_id_default, dset_id)
+ hdferr = h5dopen_c(loc_id, name, namelen, dset_id)
END SUBROUTINE h5dopen_f
@@ -368,7 +332,7 @@ CONTAINS
INTEGER(HID_T) :: mem_space_id_default
INTEGER(HID_T) :: file_space_id_default
INTEGER(HADDR_T), ALLOCATABLE, DIMENSION(:) :: ref_buf
- INTEGER :: j
+ INTEGER :: i,j
! INTEGER, EXTERNAL :: h5dwrite_ref_obj_c
! MS FORTRAN needs explicit interface for C functions called here.
@@ -2535,7 +2499,7 @@ CONTAINS
INTEGER(HID_T) :: mem_space_id_default
INTEGER(HID_T) :: file_space_id_default
INTEGER(HADDR_T), ALLOCATABLE, DIMENSION(:) :: ref_buf
- INTEGER :: j
+ INTEGER :: i,j
! INTEGER, EXTERNAL :: h5dread_ref_obj_c
! MS FORTRAN needs explicit interface for C functions called here.
@@ -4741,7 +4705,7 @@ CONTAINS
END SUBROUTINE h5dget_type_f
!----------------------------------------------------------------------
-! Name: h5dset_extent (instead of obsolete name: h5dextend_f)
+! Name: h5dextend_f
!
! Purpose: Extends a dataset with unlimited dimension.
!
@@ -4763,18 +4727,14 @@ CONTAINS
! 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 H5Dset_extent_f(dataset_id, size, hdferr)
+ SUBROUTINE h5dextend_f(dataset_id, size, hdferr)
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
-!DEC$attributes dllexport :: H5Dset_extent_f
+!DEC$attributes dllexport :: h5dextend_f
!DEC$endif
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dataset_id ! Dataset identifier
@@ -4783,22 +4743,22 @@ CONTAINS
! dimensions' sizes
INTEGER, INTENT(OUT) :: hdferr ! Error code
-! INTEGER, EXTERNAL :: H5Dset_extent_c
+! INTEGER, EXTERNAL :: h5dextend_c
! MS FORTRAN needs explicit interface for C functions called here.
!
INTERFACE
- INTEGER FUNCTION H5Dset_extent_c(dataset_id, size)
+ INTEGER FUNCTION h5dextend_c(dataset_id, size)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DSET_EXTENT_C'::H5Dset_extent_c
+ !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DEXTEND_C'::h5dextend_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: dataset_id
INTEGER(HSIZE_T), DIMENSION(*), INTENT(IN) :: size
- END FUNCTION H5Dset_extent_c
+ END FUNCTION h5dextend_c
END INTERFACE
- hdferr = H5Dset_extent_c(dataset_id, size)
- END SUBROUTINE H5Dset_extent_f
+ hdferr = h5dextend_c(dataset_id, size)
+ END SUBROUTINE h5dextend_f
!----------------------------------------------------------------------
@@ -5255,6 +5215,7 @@ CONTAINS
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, &
@@ -5685,79 +5646,4 @@ CONTAINS
hdferr = h5dget_space_status_c(dset_id, flag)
END SUBROUTINE h5dget_space_status_f
-!----------------------------------------------------------------------
-! 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
-
-
+ END MODULE H5D
diff --git a/fortran/src/H5Ff.c b/fortran/src/H5Ff.c
index 2190d05..575d92b 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 H5Fget_name function
+ * Call H5Aget_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 6cf6c05..3926656 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 f2a4187..0316c03 100644
--- a/fortran/src/H5Gf.c
+++ b/fortran/src/H5Gf.c
@@ -16,7 +16,6 @@
/* This files contains C stubs for H5G Fortran APIs */
#include "H5f90.h"
-#include "H5Eprivate.h"
/*----------------------------------------------------------------------------
* Name: h5gcreate_c
@@ -36,9 +35,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 *lcpl_id, hid_t_f *gcpl_id, hid_t_f *gapl_id )
+ hid_t_f *grp_id)
{
- hid_t c_gcpl_id = -1; /* Group creation property list */
+ hid_t gcpl_id = -1; /* Group creation property list */
char *c_name = NULL;
hid_t c_grp_id;
int_f ret_value = -1;
@@ -52,19 +51,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,(hid_t)*lcpl_id,(hid_t)*gcpl_id,(hid_t)*gapl_id);}
+ if(*size_hint == OBJECT_NAMELEN_DEFAULT_F )
+ c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
else {
- /* Create the group creation property list */
- if((c_gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 0)
- goto DONE;
+ /* Create the group creation property list */
+ if((gcpl_id = H5Pcreate(H5P_GROUP_CREATE)) < 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;
+ /* Set the local heap size hint */
+ if(H5Pset_local_heap_size_hint(gcpl_id, (size_t)*size_hint) < 0)
+ goto DONE;
- /* Create the group */
- c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, c_gcpl_id, H5P_DEFAULT);
+ /* Create the group */
+ c_grp_id = H5Gcreate2((hid_t)*loc_id, c_name, H5P_DEFAULT, gcpl_id, H5P_DEFAULT);
}
if(c_grp_id < 0)
goto DONE;
@@ -74,8 +73,8 @@ nh5gcreate_c(hid_t_f *loc_id, _fcd name, int_f *namelen, size_t_f *size_hint,
ret_value = 0;
DONE:
- if(c_gcpl_id > 0)
- H5Pclose(c_gcpl_id);
+ if(gcpl_id > 0)
+ H5Pclose(gcpl_id);
if(c_name)
HDfree(c_name);
return ret_value;
@@ -87,7 +86,6 @@ 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
@@ -95,7 +93,7 @@ DONE:
* Modifications:
*---------------------------------------------------------------------------*/
int_f
-nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *gapl_id, hid_t_f *grp_id)
+nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *grp_id)
{
char *c_name = NULL;
hid_t c_grp_id;
@@ -110,7 +108,7 @@ nh5gopen_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *gapl_id, hid_t_f
/*
* Call H5Gopen function.
*/
- if((c_grp_id = H5Gopen2((hid_t)*loc_id, c_name, (hid_t)*gapl_id)) < 0)
+ if((c_grp_id = H5Gopen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0)
goto DONE;
/* Everything OK, set values to return */
@@ -661,210 +659,3 @@ 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 6e4dd4f..5866539 100644
--- a/fortran/src/H5Gff.f90
+++ b/fortran/src/H5Gff.f90
@@ -16,18 +16,10 @@
!
! This file contains Fortran90 interfaces for H5F functions.
!
-MODULE H5G
- USE H5GLOBAL
-
-! PRIVATE :: h5gcreate1_f
-! PRIVATE :: h5gcreate2_f
-
-! INTERFACE h5gcreate_f
-! MODULE PROCEDURE h5gcreate1_f
-! MODULE PROCEDURE h5gcreate2_f
-! END INTERFACE
-
-CONTAINS
+ MODULE H5G
+ USE H5GLOBAL
+
+ CONTAINS
!----------------------------------------------------------------------
! Name: h5gcreate_f
@@ -43,12 +35,9 @@ CONTAINS
! 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
@@ -57,170 +46,56 @@ CONTAINS
! 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, lcpl_id, gcpl_id, gapl_id)
+ SUBROUTINE h5gcreate_f(loc_id, name, grp_id, hdferr, size_hint)
!
!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. 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
+!
+
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
+ CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group
+ INTEGER(HID_T), INTENT(OUT) :: grp_id ! Group identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER(SIZE_T), OPTIONAL, INTENT(IN) :: size_hint
+ ! Parameter indicating
+ ! the number of bytes
+ ! to reserve for the
+ ! names that will appear
+ ! in the group
+ INTEGER :: namelen ! Length of the name character string
+ INTEGER(SIZE_T) :: size_hint_default
+! INTEGER, EXTERNAL :: h5gcreate_c
! MS FORTRAN needs explicit interface for C functions called here.
!
- 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
- 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
+ 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
-!!$!----------------------------------------------------------------------
-!!$! 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
+ size_hint_default = OBJECT_NAMELEN_DEFAULT_F
+ if (present(size_hint)) size_hint_default = size_hint
+ namelen = LEN(name)
+ hdferr = h5gcreate_c(loc_id, name, namelen, size_hint_default, &
+ grp_id)
+ END SUBROUTINE h5gcreate_f
!----------------------------------------------------------------------
! Name: h5gopen_f
@@ -236,62 +111,54 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! gapl_id - Group access property list identifier
+! NONE
!
! 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
-!
-! Added 1.8 (optional) parameter gapl_id
-! February, 2008 M.S. Breitenfeld
+! port). March 5, 2001
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5gopen_f(loc_id, name, grp_id, hdferr, gapl_id)
+ SUBROUTINE h5gopen_f(loc_id, name, grp_id, hdferr)
!
!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(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
-
+
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
+ CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the group
+ INTEGER(HID_T), INTENT(OUT) :: grp_id ! File identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+
+ INTEGER :: namelen ! Length of the name character string
+
! INTEGER, EXTERNAL :: h5gopen_c
! MS FORTRAN needs explicit interface for C functions called here.
!
- 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
-
- gapl_id_default = H5P_DEFAULT_F
- IF(PRESENT(gapl_id)) gapl_id_default = gapl_id
+ 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, gapl_id_default, grp_id)
-
- END SUBROUTINE h5gopen_f
+ namelen = LEN(name)
+ hdferr = h5gopen_c(loc_id, name, namelen, grp_id)
+
+ END SUBROUTINE h5gopen_f
!----------------------------------------------------------------------
! Name: h5gclose_f
@@ -1062,362 +929,7 @@ CONTAINS
namelen = LEN(name)
hdferr = h5gget_comment_c(loc_id, name, namelen, size, buffer)
- 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
+ END SUBROUTINE h5gget_comment_f
- 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 b4c7660..d948259 100644
--- a/fortran/src/H5If.c
+++ b/fortran/src/H5If.c
@@ -54,11 +54,7 @@ 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:
- * 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
+ * Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5iget_name_c(hid_t_f *obj_id, _fcd buf, size_t_f *buf_size, size_t_f *name_size)
@@ -72,8 +68,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 +1;
- c_buf = (char *)HDmalloc(c_buf_size);
+ c_buf_size = (size_t)*buf_size;
+ c_buf = (char *)HDmalloc(c_buf_size +1);
if (c_buf == NULL) return ret_value;
/*
@@ -86,7 +82,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-1);
+ HD5packFstring(c_buf, _fcdtocp(buf), c_buf_size);
*name_size = (size_t_f)c_size;
ret_value = 0;
diff --git a/fortran/src/H5Lf.c b/fortran/src/H5Lf.c
deleted file mode 100644
index 208ad19..0000000
--- a/fortran/src/H5Lf.c
+++ /dev/null
@@ -1,817 +0,0 @@
-/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- * 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
deleted file mode 100644
index acb7c73..0000000
--- a/fortran/src/H5Lff.f90
+++ /dev/null
@@ -1,1323 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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
deleted file mode 100644
index 9a708da..0000000
--- a/fortran/src/H5Of.c
+++ /dev/null
@@ -1,99 +0,0 @@
-/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- * 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
deleted file mode 100644
index c64b82d..0000000
--- a/fortran/src/H5Off.f90
+++ /dev/null
@@ -1,163 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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 ea7a4bb..f674530 100644
--- a/fortran/src/H5Pf.c
+++ b/fortran/src/H5Pf.c
@@ -1,4 +1,3 @@
-
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Copyright by The HDF Group. *
* Copyright by the Board of Trustees of the University of Illinois. *
@@ -18,6 +17,7 @@
#include "H5f90.h"
+
/*----------------------------------------------------------------------------
* Name: h5pcreate_c
* Purpose: Call H5Pcreate to create a property list
@@ -2710,20 +2710,16 @@ int_f
nh5pget_class_name_c(hid_t_f *class, _fcd name, int_f *name_len)
{
int_f ret_value = -1;
- char *c_name = NULL; /* Buffer to hold C string */
- size_t c_size;
+ hid_t c_class;
+ char* c_name;
- c_size = (size_t)*name_len + 1;
- /*
- * Allocate buffer to hold name
- */
- if ((c_name = HDmalloc(c_size)) == NULL)
- goto DONE;
+
+ c_class = (hid_t)*class;
/*
* Call H5Pget_class_name function.
*/
- c_name = H5Pget_class_name((hid_t)*class);
- if(c_name == NULL) goto DONE;
+ c_name = H5Pget_class_name(c_class);
+ if( c_name == NULL) goto DONE;
HD5packFstring(c_name, _fcdtocp(name), (size_t)*name_len);
ret_value = (int_f)HDstrlen(c_name);
@@ -3135,7 +3131,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; /* error occurred */
+ if ( status < 0 ) return ret_value;
ret_value = 0;
return ret_value;
}
@@ -3418,1017 +3414,3 @@ 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 ed935e9..1c1fb90 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,18 +4665,19 @@
!----------------------------------------------------------------------
! Name: h5pget_class_name_f
!
-! Purpose: Queries the name of a class.
+! Purpose: Queries the ithe name of a class.
!
! Inputs:
! prp_id - property list identifier to query
! Outputs:
! name - name of a class
-! 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
+! 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
! Failure: -1
! Optional parameters:
! NONE
@@ -4684,12 +4685,12 @@
! Programmer: Elena Pourmal
! October 9, 2002
!
-! Modifications: Returned the size of name as an argument
+! Modifications:
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5pget_class_name_f(prp_id, name, size, hdferr)
+ SUBROUTINE h5pget_class_name_f(prp_id, name, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
@@ -4698,9 +4699,7 @@
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
- CHARACTER(LEN=*), INTENT(OUT) :: name ! Buffer to retireve class name
-
- INTEGER, INTENT(OUT) :: size ! Actual length of the class name
+ CHARACTER(LEN=*), INTENT(INOUT) :: name ! Buffer to retireve class name
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTEGER :: name_len
@@ -4716,13 +4715,8 @@
INTEGER, INTENT(IN) :: name_len
END FUNCTION h5pget_class_name_c
END INTERFACE
-
name_len = LEN(name)
- size = h5pget_class_name_c(prp_id, name, name_len)
-
- hdferr = 0
- IF(size.LT.0) hdferr = -1
-
+ hdferr = h5pget_class_name_c(prp_id, name , name_len)
END SUBROUTINE h5pget_class_name_f
!----------------------------------------------------------------------
@@ -6393,1764 +6387,4 @@
hdferr = h5premove_filter_c(prp_id, filter)
END SUBROUTINE h5premove_filter_f
-!----------------------------------------------------------------------
-! 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
-
+ END MODULE H5P
diff --git a/fortran/src/H5Rf.c b/fortran/src/H5Rf.c
index 299f6bd..4430e1a 100644
--- a/fortran/src/H5Rf.c
+++ b/fortran/src/H5Rf.c
@@ -239,102 +239,3 @@ 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 a4f4a65..6400f43 100644
--- a/fortran/src/H5Rff.f90
+++ b/fortran/src/H5Rff.f90
@@ -58,12 +58,6 @@
END INTERFACE
- INTERFACE h5rget_name_f
-
- MODULE PROCEDURE h5rget_name_object_f
- MODULE PROCEDURE h5rget_name_region_f
-
- END INTERFACE
CONTAINS
@@ -249,6 +243,7 @@
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
@@ -314,6 +309,7 @@
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
@@ -332,6 +328,7 @@
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 )
@@ -478,146 +475,4 @@
END SUBROUTINE h5rget_object_type_obj_f
-!----------------------------------------------------------------------
-! 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
+ END MODULE H5R
diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c
index c33e7e6..0a4bd40 100644
--- a/fortran/src/H5Sf.c
+++ b/fortran/src/H5Sf.c
@@ -1027,127 +1027,3 @@ 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 9e1367d..a4780c1 100644
--- a/fortran/src/H5Sff.f90
+++ b/fortran/src/H5Sff.f90
@@ -1942,170 +1942,4 @@
END SUBROUTINE h5sget_select_type_f
-!----------------------------------------------------------------------
-! 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
+ END MODULE H5S
diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c
index 0ad0bc9..7c3befc 100644
--- a/fortran/src/H5Tf.c
+++ b/fortran/src/H5Tf.c
@@ -24,7 +24,6 @@
* 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
@@ -32,7 +31,7 @@
* Modifications:
*---------------------------------------------------------------------------*/
int_f
-nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_f *tapl_id)
+nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id)
{
char *c_name = NULL;
hid_t c_type_id;
@@ -47,7 +46,7 @@ nh5topen_c (hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id, hid_t_
/*
* Call H5Topen2 function.
*/
- if((c_type_id = H5Topen2((hid_t)*loc_id, c_name, (hid_t)*tapl_id)) < 0)
+ if((c_type_id = H5Topen2((hid_t)*loc_id, c_name, H5P_DEFAULT)) < 0)
goto done;
*type_id = (hid_t_f)c_type_id;
@@ -68,19 +67,13 @@ 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,
- hid_t_f *lcpl_id, hid_t_f *tcpl_id, hid_t_f *tapl_id)
+nh5tcommit_c(hid_t_f *loc_id, _fcd name, int_f *namelen, hid_t_f *type_id)
{
char *c_name = NULL;
int ret_value = -1;
@@ -90,7 +83,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, (hid_t)*lcpl_id, (hid_t)*tcpl_id, (hid_t)*tapl_id) < 0)
+ if(H5Tcommit2((hid_t)*loc_id, c_name, (hid_t)*type_id, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT) < 0)
goto done;
ret_value = 0;
@@ -1641,202 +1634,3 @@ 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 dee6990..ee5bb77 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,62 +36,53 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! tapl_id - datatype access property list identifier.
+! NONE
!
! 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
-!
-! Added optional parameter 'tapl_id' for compatability
-! with H5Topen2. April 9, 2009.
+! Modifications: Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). March 7, 2001
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr, tapl_id)
+ SUBROUTINE h5topen_f(loc_id, name, type_id, hdferr)
!
!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(HID_T), OPTIONAL, INTENT(IN) :: tapl_id ! datatype access property list identifier
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ ! Datatype name within file or group
+ INTEGER(HID_T), INTENT(OUT) :: type_id ! Datatype identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER :: namelen ! Name length
- INTEGER :: namelen ! Name length
- INTEGER(HID_T) :: tapl_id_default
-!
+! INTEGER, EXTERNAL :: h5topen_c
! MS FORTRAN needs explicit interface for C functions called here.
!
- 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
+ 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
!----------------------------------------------------------------------
! Name: h5tcommit_f
@@ -109,84 +100,53 @@ CONTAINS
! Success: 0
! Failure: -1
! Optional parameters:
-! lcpl_id - Link creation property list
-! tcpl_id - Datatype creation property list
-! tapl_id - Datatype access property list
+! NONE
!
! 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
-!
-! - Added optional parameters introduced in version 1.8
-! M.S. Breitenfeld
-!
-!
+! Modifications: Explicit Fortran interfaces were added for
+! called C functions (it is needed for Windows
+! port). March 7, 2001
!
! Comment:
!----------------------------------------------------------------------
- SUBROUTINE h5tcommit_f(loc_id, name, type_id, hdferr, &
- lcpl_id, tcpl_id, tapl_id )
+ SUBROUTINE h5tcommit_f(loc_id, name, type_id, hdferr)
!
!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(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(HID_T), INTENT(IN) :: type_id ! Datatype identifier
+ INTEGER, INTENT(OUT) :: hdferr ! Error code
+ INTEGER :: namelen ! Name length
+! 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, &
- 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
+ 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
!----------------------------------------------------------------------
! Name: h5tcopy_f
@@ -3289,357 +3249,4 @@ CONTAINS
END SUBROUTINE h5tget_member_class_f
!----------------------------------------------------------------------
-! 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
+ END MODULE H5T
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index 77240b2..a9ac279 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -215,310 +215,213 @@ 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 *h5l_flags, int_f *h5o_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 *h5_generic_flags)
+ int_f *h5t_flags, int_f *h5z_flags)
{
int ret_value = -1;
/*
* H5D flags
*/
- 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;
+ 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;
/*
* 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[16] = (int_f)H5F_LIBVER_EARLIEST;
- h5f_flags[17] = (int_f)H5F_LIBVER_LATEST;
-
+ 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;
+
/*
* H5FD flags
*/
- 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[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 of type hid_t
*/
- 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;
+ 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;
/*
* H5G flags
*/
- 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;
+ 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;
/* 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] = (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;
+/* h5g_flags[4] = H5G_LINK; */
+ h5g_flags[5] = H5L_TYPE_ERROR;
+ h5g_flags[6] = H5L_TYPE_HARD;
+ h5g_flags[7] = H5L_TYPE_SOFT;
/*
* H5I flags
*/
- 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;
+ 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;
/*
* H5P flags
*/
- 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;
+ 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;
+
/*
* H5R flags
*/
- h5r_flags[0] = (int_f)H5R_OBJECT;
- h5r_flags[1] = (int_f)H5R_DATASET_REGION;
+ h5r_flags[0] = H5R_OBJECT;
+ h5r_flags[1] = H5R_DATASET_REGION;
/*
* H5S flags
*/
- 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[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[5] = (int_f)H5S_UNLIMITED;
h5s_flags[6] = (int_f)H5S_ALL;
- 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[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[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;
+ 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;
/*
* H5T flags
*/
- 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;
+ 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;
/*
* H5Z flags
*/
- 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 */
+ 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;
ret_value = 0;
return ret_value;
diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90
index 899ce00..eeffa34 100644
--- a/fortran/src/H5_ff.f90
+++ b/fortran/src/H5_ff.f90
@@ -13,9 +13,8 @@
! access to either file, you may request a copy from help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
-MODULE H5LIB
-
-CONTAINS
+ MODULE H5LIB
+ CONTAINS
!----------------------------------------------------------------------
! Name: h5open_f
!
@@ -38,18 +37,18 @@ CONTAINS
!
! 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
@@ -58,87 +57,78 @@ CONTAINS
!
! 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_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)
+ 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)
!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, &
- 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
+ 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
!----------------------------------------------------------------------
! Name: h5close_f
@@ -163,49 +153,49 @@ CONTAINS
! 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
@@ -229,29 +219,29 @@ CONTAINS
! 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
@@ -275,30 +265,30 @@ CONTAINS
! 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
@@ -320,28 +310,28 @@ CONTAINS
! 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
-
- 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()
+ USE H5GLOBAL
- END SUBROUTINE h5garbage_collect_f
+ 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
!----------------------------------------------------------------------
! Name: h5dont_atexit_f
@@ -363,26 +353,26 @@ CONTAINS
! 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 8a8ca8e..a13d732 100644
--- a/fortran/src/H5f90global.f90
+++ b/fortran/src/H5f90global.f90
@@ -15,20 +15,19 @@
!
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 hobj_ref_t_f
+ TYPE hobj_ref_t_f
+ INTEGER(HADDR_T) ref
+ END TYPE
- TYPE hdset_reg_ref_t_f
- INTEGER ref(REF_REG_BUF_LEN)
- END TYPE hdset_reg_ref_t_f
+ TYPE hdset_reg_ref_t_f
+ INTEGER ref(REF_REG_BUF_LEN)
+ END TYPE
INTEGER, PARAMETER :: PREDEF_TYPES_LEN = 6 ! Do not forget to change this
! value when new predefined
@@ -42,32 +41,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
@@ -77,13 +76,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)
@@ -152,7 +151,7 @@
!
! H5F flags declaration
!
- INTEGER, PARAMETER :: H5F_FLAGS_LEN = 19
+ INTEGER, PARAMETER :: H5F_FLAGS_LEN = 16
INTEGER H5F_flags(H5F_FLAGS_LEN)
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: /H5F_FLAGS/
@@ -175,8 +174,6 @@
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)
@@ -194,43 +191,10 @@
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 = 12
+ INTEGER, PARAMETER :: H5G_FLAGS_LEN = 8
INTEGER H5G_flags(H5G_FLAGS_LEN)
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: /H5G_FLAGS/
@@ -246,26 +210,16 @@
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 ! these are really H5L values -MSB-
+! XXX: Fix problems with H5G_LINK_F! - QAK
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)
-! 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)
+ EQUIVALENCE(H5G_flags(6), H5G_LINK_ERROR_F)
+ EQUIVALENCE(H5G_flags(7), H5G_LINK_HARD_F)
+ EQUIVALENCE(H5G_flags(8), H5G_LINK_SOFT_F)
!
! H5D flags declaration
!
@@ -384,6 +338,8 @@
EQUIVALENCE(H5FD_hid_flags(6), H5FD_SEC2_F)
EQUIVALENCE(H5FD_hid_flags(7), H5FD_STDIO_F)
+
+
!
! H5I flags declaration
!
@@ -409,108 +365,24 @@
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)
-!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_ORD_TRACK_F)
- EQUIVALENCE(h5o_flags(17) , H5O_HDR_ATTR_CRT_ORDE_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 = 20
+ INTEGER, PARAMETER :: H5P_FLAGS_LEN = 7
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_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
+ 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
EQUIVALENCE(H5P_flags(1), H5P_FILE_CREATE_F)
EQUIVALENCE(H5P_flags(2), H5P_FILE_ACCESS_F)
@@ -519,21 +391,9 @@
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)
+
!
-! H5R flags declaration
+! H5P flags declaration
!
INTEGER, PARAMETER :: H5R_FLAGS_LEN = 2
INTEGER H5R_flags(H5R_FLAGS_LEN)
@@ -732,27 +592,11 @@
!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)
-! 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
+ END MODULE H5GLOBAL
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 071b74a..8099ecc 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -93,9 +93,6 @@ 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 );
@@ -126,9 +123,6 @@ 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
@@ -213,7 +207,7 @@ H5_FCDLL int_f nh5sextent_equal_c ( hid_t_f * space1_id, hid_t_f *space2_id, hid
# 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 nh5dset_extent_c H5_FC_FUNC_(h5dset_extent_c, H5DSET_EXTENT_C)
+# define nh5dextend_c H5_FC_FUNC_(h5dextend_c, H5DEXTEND_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)
@@ -228,13 +222,12 @@ H5_FCDLL int_f nh5sextent_equal_c ( hid_t_f * space1_id, hid_t_f *space2_id, hid
# 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 *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 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 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);
@@ -329,7 +322,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 nh5dset_extent_c ( hid_t_f *dset_id , hsize_t_f *dims);
+H5_FCDLL int_f nh5dextend_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);
@@ -338,8 +331,6 @@ 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
@@ -357,16 +348,10 @@ H5_FCDLL int_f nh5dcreate_anon_c (hid_t_f *loc_id, hid_t_f *type_id, hid_t_f *sp
# 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,
- 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 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 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);
@@ -378,14 +363,6 @@ 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
@@ -467,25 +444,9 @@ H5_FCDLL int_f nh5gget_info_by_name_c(hid_t_f *loc_id, _fcd group_name, size_t_f
# 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 *aapl, 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 *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);
@@ -562,45 +523,6 @@ 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
@@ -661,15 +583,11 @@ H5_FCDLL int_f nh5arename_c( hid_t_f *loc_id,
# 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, 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 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 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);
@@ -678,7 +596,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 *dtype_id);
+H5_FCDLL int_f nh5tcommitted_c (hid_t_f *type_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);
@@ -723,24 +641,7 @@ 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
*/
@@ -867,37 +768,7 @@ H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, s
# 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 );
@@ -1023,37 +894,7 @@ 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
*/
@@ -1063,8 +904,6 @@ H5_FCDLL int_f nh5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks); /* MSB */
# 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);
@@ -1073,8 +912,7 @@ 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
*/
@@ -1130,10 +968,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, 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);
+ 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);
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);
@@ -1153,55 +991,4 @@ 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 04ad33d..b24d295 100644
--- a/fortran/src/HDF5.f90
+++ b/fortran/src/HDF5.f90
@@ -13,21 +13,18 @@
! 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 H5L
- USE H5S
- USE H5D
- USE H5A
- USE H5T
- USE H5O
- USE H5P
- USE H5R
- USE H5Z
- USE H5LIB
-
-END MODULE HDF5
+ 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
diff --git a/fortran/src/HDF5mpio.f90 b/fortran/src/HDF5mpio.f90
index 59ec309..95c6273 100644
--- a/fortran/src/HDF5mpio.f90
+++ b/fortran/src/HDF5mpio.f90
@@ -19,12 +19,10 @@
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 4216f34..a4f9025 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 H5Lff.f90 H5Off.f90 H5Pff.f90 H5Rff.f90 H5Sff.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 H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \
+ H5If.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \
$(PARALLEL_COND_SRC)
# h5fc and libhdf5_fortran.settings are generated during configure.
@@ -167,19 +167,17 @@ 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 H5Lff.lo \
+ H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.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 H5Lff.lo \
+ H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.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 a51254a..31baee2 100644
--- a/fortran/src/Makefile.in
+++ b/fortran/src/Makefile.in
@@ -78,20 +78,19 @@ 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 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
+ 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
@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 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)
+ 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)
libhdf5_fortran_la_OBJECTS = $(am_libhdf5_fortran_la_OBJECTS)
PROGRAMS = $(noinst_PROGRAMS)
am_H5fortran_detect_OBJECTS = H5fortran_detect.$(OBJEXT)
@@ -382,10 +381,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 H5Lff.f90 H5Off.f90 H5Pff.f90 H5Rff.f90 H5Sff.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 H5Lf.c H5Of.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \
+ H5If.c H5Pf.c H5Rf.c H5Sf.c H5Tf.c H5Zf.c \
$(PARALLEL_COND_SRC)
@@ -537,8 +536,6 @@ 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@
@@ -872,19 +869,17 @@ 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 H5Lff.lo \
+ H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.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 H5Lff.lo \
+ H5Dff.lo H5Eff.lo H5Fff.lo H5Gff.lo H5Iff.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
deleted file mode 100644
index dc65f47..0000000
--- a/fortran/src/README_DEVELOPEMENT
+++ /dev/null
@@ -1,36 +0,0 @@
-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 042cfab..ed4b9fd 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -36,10 +36,12 @@ else
endif
# Our main targets, the tests themselves
-TEST_PROG=fortranlib_test fflush1 fflush2 fortranlib_test_1_8
+TEST_PROG=fortranlib_test fflush1 fflush2
check_PROGRAMS=$(TEST_PROG)
-libh5test_fortran_la_SOURCES= tf.f90 t.c
+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
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -48,12 +50,8 @@ 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
-
-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
-
+ tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 \
+ t.c
fflush1_SOURCES=fflush1.f90
fflush2_SOURCES=fflush2.f90
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index 3c748e9..5e0b92f 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -64,10 +64,12 @@ CONFIG_HEADER = $(top_builddir)/src/H5config.h
CONFIG_CLEAN_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libh5test_fortran_la_LIBADD =
-am_libh5test_fortran_la_OBJECTS = tf.lo t.lo
+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
libh5test_fortran_la_OBJECTS = $(am_libh5test_fortran_la_OBJECTS)
am__EXEEXT_1 = fortranlib_test$(EXEEXT) fflush1$(EXEEXT) \
- fflush2$(EXEEXT) fortranlib_test_1_8$(EXEEXT)
+ fflush2$(EXEEXT)
am_fflush1_OBJECTS = fflush1.$(OBJEXT)
fflush1_OBJECTS = $(am_fflush1_OBJECTS)
fflush1_LDADD = $(LDADD)
@@ -87,7 +89,8 @@ 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-tH5E.$(OBJEXT) fortranlib_test-tf.$(OBJEXT) \
+ fortranlib_test-t.$(OBJEXT)
fortranlib_test_OBJECTS = $(am_fortranlib_test_OBJECTS)
fortranlib_test_LDADD = $(LDADD)
fortranlib_test_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
@@ -95,16 +98,6 @@ 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
@@ -125,11 +118,9 @@ 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) \
- $(fortranlib_test_1_8_SOURCES)
+ $(fflush2_SOURCES) $(fortranlib_test_SOURCES)
DIST_SOURCES = $(libh5test_fortran_la_SOURCES) $(fflush1_SOURCES) \
- $(fflush2_SOURCES) $(fortranlib_test_SOURCES) \
- $(fortranlib_test_1_8_SOURCES)
+ $(fflush2_SOURCES) $(fortranlib_test_SOURCES)
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
@@ -377,8 +368,11 @@ noinst_LTLIBRARIES = libh5test_fortran.la
@FORTRAN_SHARED_CONDITIONAL_FALSE@AM_LDFLAGS = -static
# Our main targets, the tests themselves
-TEST_PROG = fortranlib_test fflush1 fflush2 fortranlib_test_1_8
-libh5test_fortran_la_SOURCES = tf.f90 t.c
+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
+
# Source files are used for both the library and fortranlib_test.
# Automake will complain about this without the following workaround.
@@ -386,11 +380,8 @@ 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
-
-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
+ tH5Sselect.f90 tH5P.f90 tH5A.f90 tH5I.f90 tH5G.f90 tH5E.f90 tf.f90 \
+ t.c
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
@@ -478,9 +469,6 @@ 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)
@@ -488,6 +476,7 @@ 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:
@@ -511,6 +500,20 @@ 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 $@ $<
@@ -604,6 +607,12 @@ 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 f42ae6e..44c4195 100644
--- a/fortran/test/fflush1.f90
+++ b/fortran/test/fflush1.f90
@@ -58,6 +58,12 @@
! data space identifier
!
INTEGER(HID_T) :: dataspace
+
+ !
+ ! data type identifier
+ !
+ INTEGER(HID_T) :: dtype_id
+
!
!The dimensions for the dataset.
!
@@ -76,7 +82,7 @@
!
!data buffers
!
- INTEGER, DIMENSION(NX,NY) :: data_in
+ INTEGER, DIMENSION(NX,NY) :: data_in, data_out
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 38a2bd7..0414d37 100644
--- a/fortran/test/fflush2.f90
+++ b/fortran/test/fflush2.f90
@@ -50,13 +50,22 @@
! 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
deleted file mode 100644
index 970f570..0000000
--- a/fortran/test/fortranlib_test_1_8.f90
+++ /dev/null
@@ -1,966 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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 b73dd8a..44c7964 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -56,7 +56,10 @@
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) :: 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) :: aspace6_id !Null Attribute Dataspace identifier
INTEGER(HID_T) :: atype_id !String Attribute Datatype identifier
INTEGER(HID_T) :: atype2_id !Character Attribute Datatype identifier
@@ -76,8 +79,7 @@
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(HSIZE_T) :: attr_storage ! attributes storage requirements .MSB.
+ INTEGER :: num_attrs !number of attributes
CHARACTER(LEN=256) :: attr_name !buffer to put attr_name
INTEGER(SIZE_T) :: name_size = 80 !attribute name length
@@ -111,32 +113,32 @@
!
!data buffers
!
- INTEGER, DIMENSION(NX,NY) :: data_in
+ INTEGER, DIMENSION(NX,NY) :: data_in, data_out
!
!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)
@@ -245,10 +247,8 @@
!
! 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,29 +287,6 @@
!
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.
@@ -406,12 +383,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
@@ -461,10 +438,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
@@ -481,60 +458,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.
@@ -563,10 +540,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
@@ -605,7 +582,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
deleted file mode 100644
index bba0340..0000000
--- a/fortran/test/tH5A_1_8.f90
+++ /dev/null
@@ -1,3777 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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) :: attr_data1
- 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
-
- 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 859d66e..77c5fe8 100644
--- a/fortran/test/tH5F.f90
+++ b/fortran/test/tH5F.f90
@@ -697,6 +697,8 @@
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 e0270a9..437970f 100644
--- a/fortran/test/tH5G.f90
+++ b/fortran/test/tH5G.f90
@@ -58,6 +58,7 @@
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.
@@ -81,6 +82,7 @@
!
CALL h5gcreate_f(file_id, groupname2, group2_id, error)
CALL check("h5gcreate_f",error,total_error)
+
!
!Create data space for the dataset.
!
@@ -133,6 +135,7 @@
!
CALL h5glink_f(file_id, H5G_LINK_SOFT_F, dsetname2, linkname4, error)
CALL check("h5glink_f",error,total_error)
+
!
!close group1
!
@@ -162,6 +165,8 @@
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
deleted file mode 100644
index 6eee5c2..0000000
--- a/fortran/test/tH5G_1_8.f90
+++ /dev/null
@@ -1,2823 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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
deleted file mode 100644
index d0c3f16..0000000
--- a/fortran/test/tH5O.f90
+++ /dev/null
@@ -1,208 +0,0 @@
-! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-! 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 9dfc374..687bb06 100644
--- a/fortran/test/tH5R.f90
+++ b/fortran/test/tH5R.f90
@@ -17,435 +17,377 @@
!
! Testing Reference Interface functionality.
!
-! The following subroutine tests h5rcreate_f, h5rdereference_f, h5rget_name_f
+! The following subroutine tests h5rcreate_f, h5rdereference_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
-
- 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"
+ 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)
+
- 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/))
+ !
+ ! Create a group inside the file
+ !
+ CALL h5gcreate_f(file_id, groupname1, grp1_id, error)
+ CALL check("h5gcreate_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)
+ !
+ ! Create a group inside the group GROUP1
+ !
+ CALL h5gcreate_f(grp1_id, groupname2, grp2_id, error)
+ CALL check("h5gcreate_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)
+ !
+ ! 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)
- ! 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)
+ !
+ ! 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)
- ! 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)
+ !
+ ! 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)
- ! 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)
+ !
+ !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
- !
- ! 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)
+ !
+ !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
+! 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
- ! 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)
+ CHARACTER(LEN=6), PARAMETER :: filename = "Refreg"
+ CHARACTER(LEN=80) :: fix_filename
+ CHARACTER(LEN=6), PARAMETER :: dsetnamev = "MATRIX"
+ CHARACTER(LEN=17), PARAMETER :: dsetnamer = "REGION_REFERENCES"
+ 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/))
- !
- ! 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)
+ !
+ ! 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)
- 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 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)
- 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 a004ba7..2f77db9 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -52,6 +52,10 @@
!
INTEGER(HSIZE_T), DIMENSION(3) :: dimsm = (/7,7,3/)
+ !
+ !to get Dataset dimensions
+ !
+ INTEGER(HSIZE_T), DIMENSION(2) :: dims_out
!
!Dataset dimensions
@@ -99,18 +103,21 @@
!
INTEGER :: memrank = 3
-
+ !
+ !integer to get the dataspace rank from dataset
+ !
+ INTEGER :: rank
!
!general purpose integer
!
- INTEGER :: i, j
+ INTEGER :: i, j, k
!
!flag to check operation success
!
- INTEGER :: error
+ INTEGER :: error, error_n
INTEGER(HSIZE_T), DIMENSION(3) :: data_dims
@@ -390,7 +397,8 @@
!
!flag to check operation success
!
- INTEGER :: error
+ INTEGER :: error
+ LOGICAL :: status
INTEGER(HSIZE_T), DIMENSION(3) :: data_dims
@@ -712,7 +720,8 @@
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HID_T) :: dset_id ! Dataset identifier
- INTEGER(HID_T) :: dataspace ! Dataspace identifier
+ INTEGER(HID_T) :: dataspace ! Dataspace identifier
+ INTEGER(HID_T) :: memspace ! memspace identifier
!
!Dataset dimensions
@@ -754,6 +763,10 @@
!
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
@@ -789,9 +802,19 @@
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
+ INTEGER :: error, error_n
INTEGER(HSIZE_T), DIMENSION(3) :: data_dims
!
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 4857a2b..3bbb974 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, h5tencode_f, h5tdecode_f
+! h5tequal_f, h5tinsert_array_f, h5tcommit_f
USE HDF5 ! This module contains all necessary modules
@@ -88,12 +88,6 @@
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.
@@ -182,36 +176,7 @@
!
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)
-
-!!$ !/*-----------------------------------------------------------------------
-!!$ ! * 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)
+ CALL check("h5tinsert_f", error, total_error)
!
! Create the dataset with compound datatype.
@@ -520,33 +485,7 @@
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 13f2af1..998fef5 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -364,6 +364,7 @@
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
@@ -373,9 +374,10 @@
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 !general purpose integers
+ INTEGER :: i, j !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 ea567a2..2a71961 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
+ LOGICAL :: status, status1
INTEGER(HID_T) :: crtpr_id, xfer_id
INTEGER :: nfilters
INTEGER :: error
diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90
index eb033b6..673a8e2 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.f90
@@ -23,60 +23,30 @@
!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(*,*) "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$attributes dllexport :: verify
!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
-
+ 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
!----------------------------------------------------------------------
! Name: h5_fixname_f
@@ -98,46 +68,46 @@ END SUBROUTINE verifyString
!
!
!----------------------------------------------------------------------
-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
@@ -158,37 +128,37 @@ END SUBROUTINE h5_fixname_f
!
!
!----------------------------------------------------------------------
-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
@@ -210,25 +180,25 @@ END SUBROUTINE h5_cleanup_f
!
!
!----------------------------------------------------------------------
-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