mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-03-19 16:50:46 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r5956]

Browse Source 
Purpose:
    Added new F90 APIs
Description:
    I added new F90 APIs, tests, and documentation for the following
    functions:
         h5fget_obj_count_f   h5pequal_f               h5tget_member_index_f
         h5fget_obj_ids_f     h5pget_fclose_degree_f
                              h5pset_fclose_degree_f

    Documentation for exisiting functions was missing:

    h5freopen_f, h5fflush_f, h5fmount_f, h5unmount_f, h5fget_create_plist_f,
    h5fget_access_plist_f.
Platforms tested:
    Solaris 2.7, Linux 2.2 and IRIX64-6.5
This commit is contained in:
Elena Pourmal 2002-10-01 13:55:47 -05:00
parent 09325c1da6
commit 01a577a4e9
16 changed files with 1042 additions and 12 deletions

189
doc/html/fortran/h5f_FORTRAN.html

@ -128,6 +128,193 @@ FORTRAN File API -- h5f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5freopen_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5freopen_f</strong>
<pre>
SUBROUTINE h5freopen_f(file_id, new_file_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER(HID_T), INTENT(OUT) :: new_file_id ! New file identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5freopen_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fflush_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fflush_f</strong>
<pre>
SUBROUTINE h5fflush_f(obj_id, new_file_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: obj_id ! Object identifier
INTEGER, INTENT(IN) :: scope ! Flag with two possible values:
! H5F_SCOPE_GLOBAL_F
! H5F_SCOPE_LOCAL_F
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fflush_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fmount_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fmount_f</strong>
<pre>
SUBROUTINE h5fmount_f(loc_id, name, child_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
CHARACTER(LEN=*), INTENT(IN):: name ! Group name at locationloc_id
INTEGER(HID_T), INTENT(IN) :: child_id ! File(to be mounted) identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fmount_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5funmount_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5funmount_f</strong>
<pre>
SUBROUTINE h5funmount_f(loc_id, name, child_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id ! File or group identifier
CHARACTER(LEN=*), INTENT(IN):: name ! Group name at location loc_id
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5funmount_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fget_create_plist_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fget_create_plist_f</strong>
<pre>
SUBROUTINE h5fget_create_plist_f(file_id, fcpl_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER(HID_T), INTENT(OUT) :: fcpl_id ! File creation property list identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fget_create_plist_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fget_access_plist_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fget_access_plist_f</strong>
<pre>
SUBROUTINE h5fget_access_plist_f(file_id, fcpl_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER(HID_T), INTENT(OUT) :: fapl_id ! File access property list identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fget_access_plist_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fget_obj_count_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fget_obj_count_f</strong>
<pre>
SUBROUTINE h5fget_obj_count_f(file_id, obj_type, obj_count, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER, INTENT(IN) :: obj_type ! Object types, possible values are:
! H5F_OBJ_FILE_F
! H5F_OBJ_GROUP_F
! H5F_OBJ_DATASET_F
! H5F_OBJ_DATATYPE_F
! H5F_OBJ_ALL_F
INTEGER, INTENT(OUT) :: obj_count ! number of opened objects
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fget_obj_count_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5fget_obj_ids_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5fget_obj_ids_f</strong>
<pre>
SUBROUTINE h5fget_obj_ids_f(file_id, obj_type, obj_ids, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER, INTENT(IN) :: obj_type ! Object types, possible values are:
! H5F_OBJ_FILE_F
! H5F_OBJ_GROUP_F
! H5F_OBJ_DATASET_F
! H5F_OBJ_DATATYPE_F
! H5F_OBJ_ALL_F
INTEGER(HID_T), DIMENSION(*), INTENT(OUT) :: obj_ids
! array of requested object identifiers
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
END SUBROUTINE h5fget_obj_ids_f
</pre>
</dl>
@ -141,7 +328,7 @@ FORTRAN File API -- h5f
<a href="mailto:hdfhelp@ncsa.uiuc.edu">HDF Help Desk</a>
</address>
Last modified: 20 October 1999
Last modified: 30 September, 2002
<br>
Describes HDF5 Release 1.5, Unreleased Development Branch

79
doc/html/fortran/h5p_FORTRAN.html

@ -1317,6 +1317,83 @@ FORTRAN Property List API -- h5p
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5pget_fclose_degree_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5pget_fclose_degree_f</strong>
<pre>
SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier
INTEGER, INTENT(OUT) :: degree ! Info about file close behavior,
! possible values:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
INTEGER, INTENT(OUT) :: hdferr ! Error code
END SUBROUTINE h5pget_fclose_degree_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5pset_fclose_degree_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5pset_fclose_degree_f</strong>
<pre>
SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl_id ! File access property list identifier
INTEGER, INTENT(IN) :: degree ! Info about file close behavior,
! possible values:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
INTEGER, INTENT(OUT) :: hdferr ! Error code
END SUBROUTINE h5pset_fclose_degree_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5pequal_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5peqaul_f</strong>
<pre>
SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: plist1_id ! property list identifier
INTEGER(HID_T), INTENT(IN) :: plist2_id ! property list identifier
LOGICAL, INTENET(OUT) :: flag ! flag, equals to .TRUE. if
! if lists are equal, otherwise
! equals to .FALSE.
INTEGER, INTENT(OUT) :: hdferr ! Error code
END SUBROUTINE h5pequal_f
</pre>
</dl>
@ -1331,7 +1408,7 @@ FORTRAN Property List API -- h5p
<a href="mailto:hdfhelp@ncsa.uiuc.edu">HDF Help Desk</a>
</address>
Last modified: 21 August 2001
Last modified: 30 Septemeber, 2002
<br>
Describes HDF5 Release 1.5, Unreleased Development Branch

25
doc/html/fortran/h5t_FORTRAN.html

@ -853,6 +853,31 @@ FORTRAN Datatype API -- h5t
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>
<p>&nbsp;
<a name="h5tget_member_index_f">
<p>&nbsp;
</a>
<dt><strong>FORTRAN interface:</strong> &nbsp <strong>h5tget_member_index_f</strong>
<pre>
SUBROUTINE h5tget_member_index_f(type_id, member_name, index , hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier
CHARACTER(LEN=*), INTENT(IN) :: member_name !name of a field of
!a compound datatype
! or a member of ENUM type
INTEGER, INTENT(OUT) :: index !Field index (0-based) of the field name to retrieve
INTEGER, INTENT(OUT) :: hdferr ! Error code
END SUBROUTINE h5tget_member_index_f
</pre>
<p>&nbsp;
<p>&nbsp;
<hr>

61
fortran/src/H5Ff.c

@ -360,7 +360,7 @@ nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2)
* Inputs: file_id - file identifier
* Outputs: prop_id - creation property list identifier
* Returns: 0 on success, -1 on failure
* Programmer: Xiangyang Su
* Programmer: Elena Pourmal, Xiangyang Su
* Wednesday, November 3, 1999
* Modifications:
*---------------------------------------------------------------------------*/
@ -370,7 +370,7 @@ nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id)
int ret_value = -1;
hid_t c_file_id, c_prop_id;
c_file_id = *file_id;
c_file_id = (hid_t)*file_id;
c_prop_id = H5Fget_create_plist(c_file_id);
if (c_prop_id < 0) return ret_value;
@ -386,8 +386,8 @@ nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id)
* Inputs: file_id - file identifier
* Outputs: access_id - access property list identifier
* Returns: 0 on success, -1 on failure
* Programmer: Xiangyang Su
* Friday, November 5, 1999
* Programmer: Elena Pourmal
* Monday, September 30, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
@ -396,7 +396,7 @@ nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id)
int ret_value = -1;
hid_t c_file_id, c_access_id;
c_file_id = *file_id;
c_file_id = (hid_t)*file_id;
c_access_id = H5Fget_access_plist(c_file_id);
if (c_access_id < 0) return ret_value;
@ -463,3 +463,54 @@ nh5fclose_c ( hid_t_f *file_id )
if ( H5Fclose(c_file_id) < 0 ) ret_value = -1;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5fget_obj_count_c
* Purpose: Call H5Fget_obj_count to get number of open objects within a file
* Inputs: file_id - identifier of the file to be closed
* obj_type - type of the object
* Returns: obj_count - number of objects
* 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Monday, September 30, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5fget_obj_count_c ( hid_t_f *file_id , int_f *obj_type, int_f * obj_count)
{
int ret_value = 0;
hid_t c_file_id;
unsigned c_obj_type;
unsigned c_obj_count;
c_file_id = (hid_t)*file_id;
c_obj_type = (unsigned) *obj_type;
if ( H5Fget_obj_count(c_file_id, c_obj_type, &c_obj_count) < 0 ) ret_value = -1;
*obj_count = (int_f)c_obj_count;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5fget_obj_ids_c
* Purpose: Call H5Fget_obj_count to get number of open objects within a file
* Inputs: file_id - identifier of the file to be closed
* obj_type - type of the object
* Returns: obj_ids - iarray of open objects identifiers
* 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Monday, September 30, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5fget_obj_ids_c ( hid_t_f *file_id , int_f *obj_type, hid_t_f *obj_ids)
{
int ret_value = 0;
hid_t c_file_id;
unsigned c_obj_type;
c_file_id = (hid_t)*file_id;
c_obj_type = (unsigned) *obj_type;
if ( H5Fget_obj_ids(c_file_id, c_obj_type, (hid_t *)obj_ids) < 0 ) ret_value = -1;
return ret_value;
}

119
fortran/src/H5Fff.f90

@ -102,7 +102,6 @@
! H5F_SCOPE_GLOBAL_F
! H5F_SCOPE_LOCAL_F
! Outputs:
! file_id - file identifier
! hdferr: - error code
! Success: 0
! Failure: -1
@ -669,4 +668,122 @@
END SUBROUTINE h5fclose_f
!----------------------------------------------------------------------
! Name: h5fget_obj_count_f
!
! Purpose: Gets number of the objects open within a file
!
! Inputs:
! file_id - file identifier
! obj_type - type of the object; possible values are:
! H5F_OBJ_FILE_F
! H5F_OBJ_DATASET_F
! H5F_OBJ_GROUP_F
! H5F_OBJ_DATATYPE_F
! H5F_OBJ_ALL_F
! Outputs:
! obj_count - number of open objects
! hdferr: - error code
! Success: 0
! Failure: -1
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 30, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5fget_obj_count_f(file_id, obj_type, obj_count, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5fget_obj_count_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER, INTENT(IN) :: obj_type ! Object type
INTEGER, INTENT(OUT) :: obj_count ! Number of open objects
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTERFACE
INTEGER FUNCTION h5fget_obj_count_c(file_id, obj_type, obj_count)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5FGET_OBJ_COUNT_C':: h5fget_obj_count_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: file_id
INTEGER, INTENT(IN) :: obj_type ! Object type
INTEGER, INTENT(OUT) :: obj_count ! Number of open objects
END FUNCTION h5fget_obj_count_c
END INTERFACE
hdferr = h5fget_obj_count_c(file_id, obj_type, obj_count)
END SUBROUTINE h5fget_obj_count_f
!----------------------------------------------------------------------
! Name: h5fget_obj_ids_f
!
! Purpose: Get list of open objects identifiers within a file
!
! Inputs:
! file_id - file identifier
! obj_type - type of the object; possible values are:
! H5F_OBJ_FILE_F
! H5F_OBJ_DATASET_F
! H5F_OBJ_GROUP_F
! H5F_OBJ_DATATYPE_F
! H5F_OBJ_ALL_F
! Outputs:
! obj_ids - array of open object identifiers
! hdferr: - error code
! Success: 0
! Failure: -1
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 30, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5fget_obj_ids_f(file_id, obj_type, obj_ids, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5fget_obj_ids_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: file_id ! File identifier
INTEGER, INTENT(IN) :: obj_type ! Object type
INTEGER(HID_T), DIMENSION(*), INTENT(INOUT) :: obj_ids
! Array of open objects iidentifiers
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTERFACE
INTEGER FUNCTION h5fget_obj_ids_c(file_id, obj_type, obj_ids)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5FGET_OBJ_IDS_C':: h5fget_obj_ids_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: file_id
INTEGER, INTENT(IN) :: obj_type
INTEGER(HID_T), DIMENSION(*), INTENT(INOUT) :: obj_ids
END FUNCTION h5fget_obj_ids_c
END INTERFACE
hdferr = h5fget_obj_ids_c(file_id, obj_type, obj_ids)
END SUBROUTINE h5fget_obj_ids_f
END MODULE H5F

90
fortran/src/H5Pf.c

@ -97,12 +97,40 @@ nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id)
hid_t c_new_prp_id;
c_prp_id = *prp_id;
c_new_prp_id = H5Tcopy(c_prp_id);
c_new_prp_id = H5Pcopy(c_prp_id);
if ( c_new_prp_id < 0 ) ret_value = -1;
*new_prp_id = (hid_t_f)c_new_prp_id;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5pequal_c
* Purpose: Call H5Pequal to check if two property lists are equal
* Inputs: plist1_id - property list identifier
* plist2_id - property list identifier
* Outputs: c_flag - flag to indicate that lists are eqaul
* Returns: 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Monday, September 30, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f * c_flag)
{
int ret_value = 0;
hid_t c_plist1_id;
hid_t c_plist2_id;
htri_t c_c_flag;
c_plist1_id = (hid_t)*plist1_id;
c_plist2_id = (hid_t)*plist2_id;
c_c_flag = H5Pequal(c_plist1_id, c_plist2_id);
if ( c_c_flag < 0 ) ret_value = -1;
*c_flag = (int_f)c_c_flag;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5pget_class_c
@ -1798,3 +1826,63 @@ nh5pget_btree_ratios_c(hid_t_f *prp_id, real_f* left, real_f* middle, real_f* ri
ret_value = 0;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5pget_fclose_degree_c
* Purpose: Call H5Pget_fclose_degree to determine file close behavior
* Inputs: fapl_id - file access identifier
* Outputs:
* degree - possible values are:
* H5F_CLOSE_DEFAULT
* H5F_CLOSE_WEAK
* H5F_CLOSE_SEMI
* H5F_CLOSE_STRONG
* Returns: 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Thursday, September 26, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5pget_fclose_degree_c ( hid_t_f *fapl_id , int_f *degree)
{
int ret_value = -1;
hid_t c_fapl_id;
H5F_close_degree_t c_degree;
c_fapl_id = (hid_t)*fapl_id;
if( H5Pget_fclose_degree(c_fapl_id, &c_degree) < 0) return ret_value;
*degree = (int_f)c_degree;
ret_value = 0;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5pset_fclose_degree_c
* Purpose: Call H5Pset_fclose_degree to set file close behavior
* Inputs: fapl_id - file access identifier
* degree - possible values are:
* H5F_CLOSE_DEFAULT
* H5F_CLOSE_WEAK
* H5F_CLOSE_SEMI
* H5F_CLOSE_STRONG
* Returns: 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Thursday, September 26, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5pset_fclose_degree_c ( hid_t_f *fapl_id , int_f *degree)
{
int ret_value = -1;
hid_t c_fapl_id;
hid_t c_degree;
c_fapl_id = (hid_t)*fapl_id;
c_degree = (H5F_close_degree_t)*degree;
if( H5Pset_fclose_degree(c_fapl_id, c_degree) < 0) return ret_value;
ret_value = 0;
return ret_value;
}

179
fortran/src/H5Pff.f90

@ -3148,4 +3148,183 @@
hdferr = h5pget_btree_ratios_c(prp_id, left, middle, right)
END SUBROUTINE h5pget_btree_ratios_f
!----------------------------------------------------------------------
! Name: h5pget_fclose_degree_f
!
! Purpose: Returns the degree for the file close behavior.
!
! Inputs:
! fapl_id - file access property list identifier
! Outputs:
! degree - one of the following:
! Possible values are:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
! hdferr: - error code
! Success: 0
! Failure: -1
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 26, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5pget_fclose_degree_f(fapl_id, degree, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5pget_fclose_degree_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier
INTEGER, INTENT(OUT) :: degree ! Possible values
! are:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
INTEGER, INTENT(OUT) :: hdferr ! Error code
! INTEGER, EXTERNAL :: h5pget_fclose_degree_c
! MS FORTRAN needs explicit interface for C functions called here.
!
INTERFACE
INTEGER FUNCTION h5pget_fclose_degree_c(fapl_id, degree)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5PGET_FCLOSE_DEGREE_C'::h5pget_fclose_degree_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: fapl_id
INTEGER, INTENT(OUT) :: degree
END FUNCTION h5pget_fclose_degree_c
END INTERFACE
hdferr = h5pget_fclose_degree_c(fapl_id, degree)
END SUBROUTINE h5pget_fclose_degree_f
!----------------------------------------------------------------------
! Name: h5pset_fclose_degree_f
!
! Purpose: Sets the degree for the file close behavior.
!
! Inputs:
! fapl_id - file access property list identifier
! degree - one of the following:
! Possible values are:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
! Outputs:
! hdferr: - error code
! Success: 0
! Failure: -1
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 26, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5pset_fclose_degree_f(fapl_id, degree, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5pset_fclose_degree_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: fapl_id ! File Access Property list identifier
INTEGER, INTENT(IN) :: degree ! Possible values
! are:
! H5F_CLOSE_DEFAULT_F
! H5F_CLOSE_WEAK_F
! H5F_CLOSE_SEMI_F
! H5F_CLOSE_STRONG_F
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTERFACE
INTEGER FUNCTION h5pset_fclose_degree_c(fapl_id, degree)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5PSET_FCLOSE_DEGREE_C'::h5pset_fclose_degree_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: fapl_id
INTEGER, INTENT(IN) :: degree
END FUNCTION h5pset_fclose_degree_c
END INTERFACE
hdferr = h5pset_fclose_degree_c(fapl_id, degree)
END SUBROUTINE h5pset_fclose_degree_f
!----------------------------------------------------------------------
! Name: h5pequal_f
!
! Purpose: Checks if two property lists are eqaul
!
! Inputs:
! plist1_id - property list identifier
! plist2_id - property list identifier
! Outputs:
! flag - flag, possible values
! .TRUE. or .FALSE.
! hdferr: - error code
! Success: 0
! Failure: -1, flag is set to .FALSE.
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 30, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5pequal_f(plist1_id, plist2_id, flag, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5pequal_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: plist1_id ! Property list identifier
INTEGER(HID_T), INTENT(IN) :: plist2_id ! Property list identifier
LOGICAL, INTENT(OUT) :: flag ! Flag
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTEGER :: c_flag
INTERFACE
INTEGER FUNCTION h5pequal_c(plist1_id, plist2_id, c_flag)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5PEQUAL_C'::h5pequal_c
!DEC$ ENDIF
INTEGER(HID_T), INTENT(IN) :: plist1_id
INTEGER(HID_T), INTENT(IN) :: plist2_id
INTEGER, INTENT(OUT) :: c_flag
END FUNCTION h5pequal_c
END INTERFACE
flag = .FALSE.
hdferr = h5pequal_c(plist1_id, plist2_id, c_flag)
if (c_flag .GT. 0) flag = .TRUE.
END SUBROUTINE h5pequal_f
END MODULE H5P

43
fortran/src/H5Tf.c

@ -987,6 +987,49 @@ nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member_name, int_f
ret_value = 0;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5tget_member_index_c
* Purpose: Call H5Tget_member_index to get an index of
* the specified datatype filed or member.
* Inputs: type_id - datatype identifier
* name - name of the datatype within file or group
* namelen - name length
* Outputs: index - 0-based index
* Returns: 0 on success, -1 on failure
* Programmer: Elena Pourmal
* Thursday, September 26, 2002
* Modifications:
*---------------------------------------------------------------------------*/
int_f
nh5tget_member_index_c (hid_t_f *type_id, _fcd name, int_f *namelen, int_f *index)
{
int ret_value = -1;
char *c_name;
int c_namelen;
hid_t c_type_id;
int c_index;
/*
* Convert FORTRAN name to C name
*/
c_namelen = *namelen;
c_name = (char *)HD5f2cstring(name, c_namelen);
if (c_name == NULL) return ret_value;
/*
* Call H5Tget_member_index function.
*/
c_type_id = (hid_t)*type_id;
c_index = H5Tget_member_index(c_type_id, c_name);
if (c_index < 0) goto DONE;
*index = (int_f)c_index;
DONE:
HDfree(c_name);
ret_value = 0;
return ret_value;
}
/*----------------------------------------------------------------------------
* Name: h5tget_member_offset_c

59
fortran/src/H5Tff.f90

@ -1912,7 +1912,7 @@
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5tget_member_name_f(type_id,index, member_name, namelen, hdferr)
SUBROUTINE h5tget_member_name_f(type_id, index, member_name, namelen, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
@ -2004,6 +2004,63 @@
hdferr = h5tget_member_offset_c(type_id, member_no, offset )
END SUBROUTINE h5tget_member_offset_f
!----------------------------------------------------------------------
! Name: h5tget_member_index_f
!
! Purpose: Retrieves the index of a compound or enumeration datatype member.
!
! Inputs:
! type_id - datatype identifier
! name - name of the field or member whose index to
! to be retrieved from the datatype.
! Outputs:
! index - 0-based index of the filed or member (0 to N-1)
! hdferr: - error code
! Success: 0
! Failure: -1
! Optional parameters:
! NONE
!
! Programmer: Elena Pourmal
! September 26, 2002
!
! Modifications:
!
! Comment:
!----------------------------------------------------------------------
SUBROUTINE h5tget_member_index_f(type_id, name, index, hdferr)
!
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: h5tget_member_index_f
!DEC$endif
!
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier
CHARACTER(LEN=*), INTENT(IN) :: name ! Field or member name
INTEGER, INTENT(OUT) :: index ! Field or member index
INTEGER, INTENT(OUT) :: hdferr ! Error code
INTEGER :: namelen ! Name length
INTERFACE
INTEGER FUNCTION h5tget_member_index_c(type_id, name, namelen, index)
USE H5GLOBAL
!DEC$ IF DEFINED(HDF5F90_WINDOWS)
!MS$ATTRIBUTES C,reference,alias:'_H5TGET_MEMBER_INDEX_C'::h5tget_member_index_c
!DEC$ ENDIF
!DEC$ATTRIBUTES reference ::name
INTEGER(HID_T), INTENT(IN) :: type_id
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER, INTENT(IN) :: namelen
INTEGER, INTENT(OUT) :: index
END FUNCTION h5tget_member_index_c
END INTERFACE
namelen = LEN(name)
hdferr = h5tget_member_index_c(type_id, name, namelen, index)
END SUBROUTINE h5tget_member_index_f
!----------------------------------------------------------------------
! Name: h5tget_member_dim_f

9
fortran/src/H5_f.c

@ -209,6 +209,15 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, int_f *h5f_flags,
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

20
fortran/src/H5f90global.f90

@ -135,7 +135,7 @@
!
! H5F flags declaration
!
INTEGER, PARAMETER :: H5F_FLAGS_LEN = 7
INTEGER, PARAMETER :: H5F_FLAGS_LEN = 16
INTEGER H5F_flags(H5F_FLAGS_LEN)
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$ ATTRIBUTES DLLEXPORT :: /H5F_FLAGS/
@ -149,6 +149,15 @@
INTEGER :: H5F_ACC_DEBUG_F
INTEGER :: H5F_SCOPE_LOCAL_F
INTEGER :: H5F_SCOPE_GLOBAL_F
INTEGER :: H5F_CLOSE_DEFAULT_F
INTEGER :: H5F_CLOSE_WEAK_F
INTEGER :: H5F_CLOSE_SEMI_F
INTEGER :: H5F_CLOSE_STRONG_F
INTEGER :: H5F_OBJ_FILE_F
INTEGER :: H5F_OBJ_DATASET_F
INTEGER :: H5F_OBJ_GROUP_F
INTEGER :: H5F_OBJ_DATATYPE_F
INTEGER :: H5F_OBJ_ALL_F
EQUIVALENCE(H5F_flags(1), H5F_ACC_RDWR_F)
EQUIVALENCE(H5F_flags(2), H5F_ACC_RDONLY_F)
@ -157,6 +166,15 @@
EQUIVALENCE(H5F_flags(5), H5F_ACC_DEBUG_F)
EQUIVALENCE(H5F_flags(6), H5F_SCOPE_LOCAL_F)
EQUIVALENCE(H5F_flags(7), H5F_SCOPE_GLOBAL_F)
EQUIVALENCE(H5F_flags(8), H5F_CLOSE_DEFAULT_F)
EQUIVALENCE(H5F_flags(9), H5F_CLOSE_WEAK_F)
EQUIVALENCE(H5F_flags(10), H5F_CLOSE_SEMI_F)
EQUIVALENCE(H5F_flags(11), H5F_CLOSE_STRONG_F)
EQUIVALENCE(H5F_flags(12), H5F_OBJ_FILE_F)
EQUIVALENCE(H5F_flags(13), H5F_OBJ_DATASET_F)
EQUIVALENCE(H5F_flags(14), H5F_OBJ_GROUP_F)
EQUIVALENCE(H5F_flags(15), H5F_OBJ_DATATYPE_F)
EQUIVALENCE(H5F_flags(16), H5F_OBJ_ALL_F)
!
! H5G flags declaration
!

27
fortran/src/H5f90proto.h

@ -22,6 +22,8 @@ H5_DLL int HD5packFstring(char *src, char *dest, int len);
# define nh5freopen_c FNAME(H5FREOPEN_C)
# define nh5fget_create_plist_c FNAME(H5FGET_CREATE_PLIST_C)
# define nh5fget_access_plist_c FNAME(H5FGET_ACCESS_PLIST_C)
# define nh5fget_obj_count_c FNAME(H5FGET_OBJ_COUNT_C)
# define nh5fget_obj_ids_c FNAME(H5FGET_OBJ_IDS_C)
#else /* !DF_CAPFNAMES */
# define nh5fcreate_c FNAME(h5fcreate_c)
# define nh5fflush_c FNAME(h5fflush_c)
@ -33,6 +35,8 @@ H5_DLL int HD5packFstring(char *src, char *dest, int len);
# define nh5freopen_c FNAME(h5freopen_c)
# define nh5fget_create_plist_c FNAME(h5fget_create_plist_c)
# define nh5fget_access_plist_c FNAME(h5fget_access_plist_c)
# define nh5fget_obj_count_c FNAME(h5fget_obj_count_c)
# define nh5fget_obj_ids_c FNAME(h5fget_obj_ids_c)
#endif /* DF_CAPFNAMES */
#endif /* H5Ff90_FNAMES */
@ -51,8 +55,15 @@ H5_DLL int_f nh5fmount_c
H5_DLL int_f nh5funmount_c
(hid_t_f *loc_id, _fcd dsetname, int_f *namelen);
H5_DLL int_f nh5freopen_c (hid_t_f *file_id1, hid_t_f *file_id2);
H5_DLL int_f nh5fget_create_plist_c (hid_t_f *file_id, hid_t_f *prop_id);
H5_DLL int_f nh5fget_access_plist_c (hid_t_f *file_id, hid_t_f *access_id);
H5_DLL int_f nh5fget_obj_count_c (hid_t_f *file_id, int_f *obj_type, int_f *obj_count);
H5_DLL int_f nh5fget_obj_ids_c (hid_t_f *file_id, int_f *obj_type, int_f *obj_ids);
/*
* Functions from H5Sf.c
*/
@ -424,6 +435,7 @@ H5_DLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
# define nh5tget_member_offset_c FNAME(H5TGET_MEMBER_OFFSET_C)
# define nh5tget_member_dims_c FNAME(H5TGET_MEMBER_DIMS_C)
# define nh5tget_member_type_c FNAME(H5TGET_MEMBER_TYPE_C)
# define nh5tget_member_index_c FNAME(H5TGET_MEMBER_INDEX_C)
# define nh5tinsert_c FNAME(H5TINSERT_C)
# define nh5tcreate_c FNAME(H5TCREATE_C)
# define nh5tpack_c FNAME(H5TPACK_C)
@ -478,6 +490,7 @@ H5_DLL int_f nh5aget_name_c(hid_t_f *attr_id, size_t_f *size, _fcd buf);
# define nh5tget_member_offset_c FNAME(h5tget_member_offset_c)
# define nh5tget_member_dims_c FNAME(h5tget_member_dims_c)
# define nh5tget_member_type_c FNAME(h5tget_member_type_c)
# define nh5tget_member_index_c FNAME(h5tget_member_index_c)
# define nh5tinsert_c FNAME(h5tinsert_c)
# define nh5tcreate_c FNAME(h5tcreate_c)
# define nh5tpack_c FNAME(h5tpack_c)
@ -547,6 +560,8 @@ H5_DLL int_f nh5tget_member_name_c ( hid_t_f *type_id ,int_f* index, _fcd member
H5_DLL int_f nh5tget_member_dims_c ( hid_t_f *type_id ,int_f* field_idx, int_f * dims, size_t_f * field_dims, int_f * perm );
H5_DLL int_f nh5tget_member_offset_c ( hid_t_f *type_id ,int_f* member_no, size_t_f* offset);
H5_DLL int_f nh5tget_member_type_c ( hid_t_f *type_id ,int_f* field_idx, hid_t_f * datatype);
H5_DLL int_f nh5tget_member_index_c ( hid_t_f *type_id ,_fcd name, int_f* namelen, int_f *index);
H5_DLL int_f nh5tinsert_c(hid_t_f *type_id, _fcd name, int_f* namelen, size_t_f *offset, hid_t_f * field_id);
H5_DLL int_f nh5tpack_c(hid_t_f * type_id);
@ -587,6 +602,7 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pcreate_c FNAME(H5PCREATE_C)
# define nh5pclose_c FNAME(H5PCLOSE_C)
# define nh5pcopy_c FNAME(H5PCOPY_C)
# define nh5pequal_c FNAME(H5PEQUAL_C)
# define nh5pget_class_c FNAME(H5PGET_CLASS_C)
# define nh5pset_deflate_c FNAME(H5PSET_DEFLATE_C)
# define nh5pset_preserve_c FNAME(H5PSET_PRESERVE_C)
@ -639,11 +655,14 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pget_fapl_mpio_c FNAME(H5PGET_FAPL_MPIO_C)
# define nh5pset_dxpl_mpio_c FNAME(H5PSET_DXPL_MPIO_C)
# define nh5pget_dxpl_mpio_c FNAME(H5PGET_DXPL_MPIO_C)
# define nh5pget_fclose_degree_c FNAME(H5PGET_FCLOSE_DEGREE_C)
# define nh5pset_fclose_degree_c FNAME(H5PSET_FCLOSE_DEGREE_C)
#else
# define nh5pcreate_c FNAME(h5pcreate_c)
# define nh5pclose_c FNAME(h5pclose_c)
# define nh5pcopy_c FNAME(h5pcopy_c)
# define nh5pequal_c FNAME(h5pequal_c)
# define nh5pget_class_c FNAME(h5pget_class_c)
# define nh5pset_deflate_c FNAME(h5pset_deflate_c)
# define nh5pset_preserve_c FNAME(h5pset_preserve_c)
@ -696,6 +715,9 @@ nh5tget_super_c ( hid_t_f *type_id , hid_t_f *base_type_id);
# define nh5pget_fapl_mpio_c FNAME(h5pget_fapl_mpio_c)
# define nh5pset_dxpl_mpio_c FNAME(h5pset_dxpl_mpio_c)
# define nh5pget_dxpl_mpio_c FNAME(h5pget_dxpl_mpio_c)
# define nh5pget_fclose_degree_c FNAME(h5pget_fclose_degree_c)
# define nh5pset_fclose_degree_c FNAME(h5pset_fclose_degree_c)
#endif
#endif
@ -706,6 +728,8 @@ H5_DLL int_f nh5pclose_c ( hid_t_f *prp_id );
H5_DLL int_f nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id);
H5_DLL int_f nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f *c_flag);
H5_DLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype);
H5_DLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level);
@ -815,7 +839,8 @@ H5_DLL int_f
nh5pget_dxpl_mpio_rc(hid_t_f *prp_id, int_f* data_xfer_mode);
H5_DLL int_f
nh5pset_dxpl_mpio_c(hid_t_f *prp_id, int_f* data_xfer_mode);
H5_DLL int_f nh5pset_fclose_degree_c(hid_t_f *fapl, int_f *degree);
H5_DLL int_f nh5pget_fclose_degree_c(hid_t_f *fapl, int_f *degree);
/*
* Functions frome H5Rf.c
*/

9
fortran/test/fortranlib_test.f90

@ -26,6 +26,7 @@
INTEGER :: error
INTEGER :: mounting_total_error = 0
INTEGER :: reopen_total_error = 0
INTEGER :: fclose_total_error = 0
INTEGER :: dataset_total_error = 0
INTEGER :: extend_dataset_total_error = 0
INTEGER :: refobj_total_error = 0
@ -89,6 +90,14 @@
write(*, fmt = e_format) error_string
total_error = total_error + reopen_total_error
error_string = failure
CALL file_close(cleanup, fclose_total_error)
IF (fclose_total_error == 0) error_string = success
write(*, fmt = '(21a)', advance = 'no') ' File open/close test'
write(*, fmt = '(49x,a)', advance = 'no') ' '
write(*, fmt = e_format) error_string
total_error = total_error + fclose_total_error
! write(*,*)
! write(*,*) '========================================='

126
fortran/test/tH5F.f90

@ -543,6 +543,132 @@
END SUBROUTINE plisttest
!
! The following subroutine tests h5pget(set)_fclose_degree_f
!
SUBROUTINE file_close(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
INTEGER :: error
!
CHARACTER(LEN=10), PARAMETER :: filename = "file_close"
CHARACTER(LEN=80) :: fix_filename
INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers
INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers
INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers
LOGICAL :: flag
INTEGER :: obj_count, obj_countf
INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids
INTEGER :: i
CALL h5eset_auto_f(0, error)
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, fid, error)
CALL check("h5fcreate_f",error,total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
CALL check("h5pcreate_f",error,total_error)
CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error)
CALL check("h5pset_fclose_degree_f",error,total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error)
CALL check("h5pcreate_f",error,total_error)
CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error)
CALL check("h5pset_fclose_degree_f",error,total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error)
CALL check("h5pcreate_f",error,total_error)
CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error)
CALL check("h5pset_fclose_degree_f",error,total_error)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error)
CALL check("h5pcreate_f",error,total_error)
CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error)
CALL check("h5pset_fclose_degree_f",error,total_error)
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1)
CALL check("h5fopen_f",error,total_error)
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl)
CALL check("h5fopen_f",error,total_error)
CALL h5fget_access_plist_f(fid1, fid1_fapl, error)
CALL check("h5fget_access_plist_f",error,total_error)
CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error)
CALL check("h5fget_access_plist_f",error,total_error)
CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error)
CALL check("h5pequal_f",error,total_error)
if (.NOT. flag) then
write(*,*) " File access lists should be equal, error "
total_error=total_error + 1
endif
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2)
if( error .ne. -1) then
total_error = total_error + 1
write(*,*) " Open with H5F_CLOSE_SEMI should fail "
endif
CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3)
if( error .ne. -1) then
total_error = total_error + 1
write(*,*) " Open with H5F_CLOSE_STRONG should fail "
endif
CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error)
CALL check("h5fget_obj_count_f",error,total_error)
if(error .eq.0 .and. obj_count .ne. 3) then
total_error = total_error + 1
write(*,*) "Wrong number of open objects reported, error"
endif
CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error)
CALL check("h5fget_obj_count_f",error,total_error)
if(error .eq.0 .and. obj_countf .ne. 3) then
total_error = total_error + 1
write(*,*) "Wrong number of open objects reported, error"
endif
allocate(obj_ids(obj_countf), stat = error)
CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_ids, error)
CALL check("h5fget_obj_ids_f",error,total_error)
if(error .eq. 0) then
do i = 1, obj_countf
CALL h5fclose_f(obj_ids(i), error)
CALL check("h5fclose_f",error,total_error)
enddo
endif
CALL h5fclose_f(fid, error)
if(error .eq. 0) then
total_error = total_error + 1
write(*,*) "File should be closed at this point, error"
endif
CALL h5fclose_f(fid1, error)
if(error .eq. 0) then
total_error = total_error + 1
write(*,*) "File should be closed at this point, error"
endif
CALL h5fclose_f(fid_d, error)
if(error .eq. 0) then
total_error = total_error + 1
write(*,*) "File should be closed at this point, error"
endif
if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
deallocate(obj_ids)
RETURN
END SUBROUTINE file_close

9
fortran/test/tH5T.f90

@ -81,6 +81,7 @@
INTEGER :: num_members ! Number of members in the compound datatype
CHARACTER(LEN=256) :: member_name
INTEGER :: len ! Lenght of the name of the compound datatype member
INTEGER :: member_index ! index of the field
LOGICAL :: flag
INTEGER(HSIZE_T), DIMENSION(3) :: array_dims=(/2,3,4/)
INTEGER :: array_dims_range = 3
@ -305,12 +306,20 @@
endif
!
! Go through the members and find out their names and offsets.
! Also see if name corresponds to the index
!
do i = 1, num_members
CALL h5tget_member_name_f(dtype_id, i-1, member_name, len, error)
CALL check("h5tget_member_name_f", error, total_error)
CALL h5tget_member_offset_f(dtype_id, i-1, offset_out, error)
CALL check("h5tget_member_offset_f", error, total_error)
CALL h5tget_member_index_f(dtype_id, member_name(1:len), member_index, error)
CALL check("h5tget_member_index_f", error, total_error)
if(member_index .ne. i-1) then
write(*,*) "Index returned is incorrect"
write(*,*) member_index, i-1
total_error = total_error + 1
endif
CHECK_NAME: SELECT CASE (member_name(1:len))
CASE("char_field")

10
release_docs/RELEASE.txt

@ -394,9 +394,19 @@ New Features
h5get_libversion_f h5dont_atexit_f
h5check_version_f h5garbage_collect_f
EIP - 2002/09/24
H5F APIs:
h5fget_obj_count_f h5fget_obj_ids_f
EIP - 2002/10/01
H5G APIs:
h5glink2_f and h5gmove2_f
EIP - 2002/09/25
H5P APIs:
h5pequal_f
h5pget(set)_fclose_degree_f
H5T APIs:
h5tget_member_index_f
EIP - 2002/10/01
* C++ API:
- Added two new member functions: Exception::getFuncName() and