mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-03-31 17:10:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r22824] FIX: HDFFV-8118: Support Fortran compiler flags that change the default size of integer and real

Browse Source 
Tested: jam(gnu,intel), machine with gcc 4.7 and C long double = 16 bytes.
This commit is contained in:
Scot Breitenfeld 2012-09-27 14:13:13 -05:00
parent 0710ab3955
commit a81cc2ac7e
12 changed files with 437 additions and 244 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
fortran/src/H5Rf.c
View File

@ -331,6 +331,47 @@ done:
return ret_value;
} /* end nh5rget_region_region_c() */
/****if* H5Rf/h5rget_region_ptr_c
* NAME
* h5rget_region_ptr_c
* PURPOSE
* Call H5Rget_region to dereference dataspace region
* INPUTS
* dset_id - dataset identifier
* ref - reference to the dataset region
* OUTPUTS
* space_id - dereferenced dataset dataspace identifier
* RETURNS
* 0 on success, -1 on failure
* AUTHOR
* M. Scot Breitenfeld
* August 4, 2012
* HISTORY
*
* SOURCE
*/
int_f
nh5rget_region_ptr_c(hid_t_f *dset_id, void *ref, hid_t_f *space_id)
/******/
{
hid_t c_space_id;
hdset_reg_ref_t ref_c;
int_f ret_value = 0;
/*
* Call H5Rget_region function.
*/
if((c_space_id = H5Rget_region((hid_t)*dset_id, H5R_DATASET_REGION, ref)) < 0)
HGOTO_DONE(FAIL)
/* Copy the dataspace ID */
*space_id = (hid_t_f)c_space_id;
done:
return ret_value;
} /* end nh5rget_region_ptr_c() */
/****if* H5Rf/h5rget_object_type_obj_c
* NAME
* h5rget_object_type_obj_c

61
fortran/src/H5Rff.f90
View File

@ -53,12 +53,6 @@ MODULE H5R
! END TYPE
!
INTERFACE h5rget_region_f
MODULE PROCEDURE h5rget_region_region_f
END INTERFACE
INTERFACE h5rget_object_type_f
MODULE PROCEDURE h5rget_object_type_obj_f
@ -67,61 +61,6 @@ MODULE H5R
CONTAINS
!****s* H5R/h5rget_region_region_f
!
! NAME
! h5rget_region_region_f
!
! PURPOSE
! Retrieves a dataspace with the specified region selected
!
! INPUTS
! dset_id - identifier of the dataset containing
! reference to the regions
! ref - reference to open
! OUTPUTS
! space_id - dataspace identifier
! hdferr - Returns 0 if successful and -1 if fails
! AUTHOR
! Elena Pourmal
! August 12, 1999
!
! HISTORY
! Explicit Fortran interfaces were added for
! called C functions (it is needed for Windows
! port). February 28, 2001
!
! NOTES
! This is a module procedure for the h5rget_region_f subroutine.
!
! SOURCE
SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
INTERFACE
INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
!DEC$ENDIF
INTEGER(HID_T), INTENT(IN) :: dset_id
! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
INTEGER :: ref_f(REF_REG_BUF_LEN)
INTEGER(HID_T), INTENT(OUT) :: space_id
END FUNCTION h5rget_region_region_c
END INTERFACE
ref_f = ref%ref
hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
END SUBROUTINE h5rget_region_region_f
!****s* H5R/h5rget_object_type_obj_f
!
! NAME

174
fortran/src/H5Rff_F03.f90
View File

@ -37,6 +37,7 @@
!*****
MODULE H5R_PROVISIONAL
USE H5GLOBAL
USE, INTRINSIC :: ISO_C_BINDING
! If you change the value of these parameters, do not forget to change corresponding
! values in the H5f90.h file.
@ -51,6 +52,19 @@ MODULE H5R_PROVISIONAL
! INTEGER ref(REF_REG_BUF_LEN)
! END TYPE
!
TYPE :: hdset_reg_ref_t_f03
INTEGER(C_SIGNED_CHAR), DIMENSION(1:H5R_DSET_REG_REF_BUF_SIZE_F) :: ref
END TYPE hdset_reg_ref_t_f03
INTERFACE h5rget_region_f
MODULE PROCEDURE h5rget_region_region_f ! obsolete
MODULE PROCEDURE h5rget_region_ptr_f ! F2003
END INTERFACE
INTERFACE h5rcreate_f
MODULE PROCEDURE h5rcreate_object_f ! obsolete
@ -123,8 +137,114 @@ MODULE H5R_PROVISIONAL
END FUNCTION h5rcreate_ptr_c
END INTERFACE
INTERFACE
INTEGER FUNCTION h5rget_region_ptr_c(dset_id, ref, space_id)
USE, INTRINSIC :: ISO_C_BINDING
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_PTR_C':: h5rget_region_ptr_c
!DEC$ENDIF
INTEGER(HID_T), INTENT(IN) :: dset_id
TYPE(C_PTR), VALUE :: ref
INTEGER(HID_T), INTENT(OUT) :: space_id
END FUNCTION h5rget_region_ptr_c
END INTERFACE
CONTAINS
!****s* H5R/h5rget_region_region_f
!
! NAME
! h5rget_region_region_f
!
! PURPOSE
! Retrieves a dataspace with the specified region selected
!
! INPUTS
! dset_id - identifier of the dataset containing
! reference to the regions
! ref - reference to open
! OUTPUTS
! space_id - dataspace identifier
! hdferr - Returns 0 if successful and -1 if fails
! AUTHOR
! Elena Pourmal
! August 12, 1999
!
! HISTORY
! Explicit Fortran interfaces were added for
! called C functions (it is needed for Windows
! port). February 28, 2001
!
! NOTES
! This is a module procedure for the h5rget_region_f subroutine.
!
! SOURCE
SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
INTERFACE
INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
!DEC$ENDIF
INTEGER(HID_T), INTENT(IN) :: dset_id
! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
INTEGER :: ref_f(REF_REG_BUF_LEN)
INTEGER(HID_T), INTENT(OUT) :: space_id
END FUNCTION h5rget_region_region_c
END INTERFACE
ref_f = ref%ref
hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
END SUBROUTINE h5rget_region_region_f
!****s* H5R/h5rget_region_ptr_f
!
! NAME
! h5rget_region_ptr_f
!
! PURPOSE
! Retrieves a dataspace with the specified region
! selected using pointer
!
! INPUTS
! dset_id - identifier of the dataset containing
! reference to the regions
! ref - reference to open
! OUTPUTS
! space_id - dataspace identifier
! hdferr - Returns 0 if successful and -1 if fails
! AUTHOR
! M. Scot Breitenfeld
! August 4, 2012
!
! NOTES
! This is a module procedure for the h5rget_region_f subroutine.
!
! SOURCE
SUBROUTINE h5rget_region_ptr_f(dset_id, ref, space_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
TYPE(C_PTR), INTENT(IN) :: ref ! Dataset region reference
INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
hdferr = h5rget_region_ptr_c(dset_id, ref, space_id )
END SUBROUTINE h5rget_region_ptr_f
!****s* H5R (F03)/h5rcreate_object_f
!
! NAME
@ -175,7 +295,7 @@ CONTAINS
END SUBROUTINE h5rcreate_object_f
!****s* H5R (F03)/h5rcreate_region_f
!****s* H5R (F90)/h5rcreate_region_f
!
! NAME
! h5rcreate_region_f
@ -183,16 +303,15 @@ CONTAINS
! PURPOSE
! Creates reference to the dataset region
!
! Inputs:
! INPUTS
! loc_id - location identifier
! name - name of the dataset at the specified location
! space_id - dataspace identifier that describes selected region
! Outputs:
! OUTPUTS
! ref - reference to the dataset region
! hdferr: - error code
! Success: 0
! Failure: -1
!
! AUTHOR
! Elena Pourmal
! August 12, 1999
@ -205,46 +324,39 @@ CONTAINS
! NOTES
! This is a module procedure for the h5rcreate_f subroutine.
!
! Signature:
! SOURCE
SUBROUTINE h5rcreate_region_f(loc_id, name, space_id, ref, hdferr)
USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: loc_id ! Location identifier
CHARACTER(LEN=*), INTENT(IN) :: name ! Name of the dataset at location specified
! by loc_id identifier
INTEGER(HID_T), INTENT(IN) :: space_id ! Dataset's dataspace identifier
TYPE(hdset_reg_ref_t_f), INTENT(INOUT), TARGET :: ref ! Dataset region reference
TYPE(hdset_reg_ref_t_f), INTENT(OUT) :: ref ! Dataset region reference
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: namelen ! Name length
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
TYPE(C_PTR) :: f_ptr
! !$ INTERFACE
! !$ INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id)
! !$ USE H5GLOBAL
! !$ !DEC$IF DEFINED(HDF5F90_WINDOWS)
! !$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c
! !$ !DEC$ENDIF
! !$ !DEC$ATTRIBUTES reference :: name
! !$ ! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
! !$ INTEGER :: ref_f(REF_REG_BUF_LEN)
! !$ INTEGER(HID_T), INTENT(IN) :: loc_id
! !$ CHARACTER(LEN=*), INTENT(IN) :: name
! !$ INTEGER :: namelen
! !$ INTEGER(HID_T), INTENT(IN) :: space_id
! !$ END FUNCTION h5rcreate_region_c
! !$ END INTERFACE
f_ptr = C_LOC(ref)
INTERFACE
INTEGER FUNCTION h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5RCREATE_REGION_C':: h5rcreate_region_c
!DEC$ENDIF
!DEC$ATTRIBUTES reference :: name
! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
INTEGER :: ref_f(REF_REG_BUF_LEN)
INTEGER(HID_T), INTENT(IN) :: loc_id
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER :: namelen
INTEGER(HID_T), INTENT(IN) :: space_id
END FUNCTION h5rcreate_region_c
END INTERFACE
namelen = LEN(name)
hdferr = h5rcreate_ptr_c(f_ptr, loc_id, name, namelen, 1, space_id)
! !$ ref_f = 0
! !$ hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id )
! !$ ref%ref = ref_f
ref_f = 0
hdferr = h5rcreate_region_c(ref_f, loc_id, name, namelen, space_id )
ref%ref = ref_f
END SUBROUTINE h5rcreate_region_f

65
fortran/src/H5Rff_F90.f90
View File

@ -72,8 +72,73 @@ MODULE H5R_PROVISIONAL
END INTERFACE
INTERFACE h5rget_region_f
MODULE PROCEDURE h5rget_region_region_f
END INTERFACE
CONTAINS
!****s* H5R/h5rget_region_region_f
!
! NAME
! h5rget_region_region_f
!
! PURPOSE
! Retrieves a dataspace with the specified region selected
!
! INPUTS
! dset_id - identifier of the dataset containing
! reference to the regions
! ref - reference to open
! OUTPUTS
! space_id - dataspace identifier
! hdferr - Returns 0 if successful and -1 if fails
! AUTHOR
! Elena Pourmal
! August 12, 1999
!
! HISTORY
! Explicit Fortran interfaces were added for
! called C functions (it is needed for Windows
! port). February 28, 2001
!
! NOTES
! This is a module procedure for the h5rget_region_f subroutine.
!
! SOURCE
SUBROUTINE h5rget_region_region_f(dset_id, ref, space_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
TYPE(hdset_reg_ref_t_f), INTENT(IN) :: ref ! Dataset region reference
INTEGER(HID_T), INTENT(OUT) :: space_id ! Space identifier
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
INTEGER :: ref_f(REF_REG_BUF_LEN) ! Local buffer to pass reference
INTERFACE
INTEGER FUNCTION h5rget_region_region_c(dset_id, ref_f, space_id)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5RGET_REGION_REGION_C':: h5rget_region_region_c
!DEC$ENDIF
INTEGER(HID_T), INTENT(IN) :: dset_id
! INTEGER, PARAMETER :: REF_REG_BUF_LEN = 3
INTEGER :: ref_f(REF_REG_BUF_LEN)
INTEGER(HID_T), INTENT(OUT) :: space_id
END FUNCTION h5rget_region_region_c
END INTERFACE
ref_f = ref%ref
hdferr = h5rget_region_region_c(dset_id, ref_f, space_id )
END SUBROUTINE h5rget_region_region_f
!****s* H5R (F90)/h5rcreate_object_f
!
! NAME

2
fortran/src/H5f90proto.h
View File

@ -1179,6 +1179,7 @@ H5_FCDLL int_f nh5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_
#define nh5rdereference_object_c H5_FC_FUNC_(h5rdereference_object_c, H5RDEREFERENCE_OBJECT_C)
#define nh5rdereference_ptr_c H5_FC_FUNC_(h5rdereference_ptr_c, H5RDEREFERENCE_PTR_C)
#define nh5rget_region_region_c H5_FC_FUNC_(h5rget_region_region_c, H5RGET_REGION_REGION_C)
#define nh5rget_region_ptr_c H5_FC_FUNC_(h5rget_region_ptr_c, H5RGET_REGION_PTR_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)
@ -1193,6 +1194,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 nh5rdereference_ptr_c (hid_t_f *obj_id, int_f *ref_type, void *ref, hid_t_f *ref_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_region_ptr_c(hid_t_f *dset_id, void *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);

24
fortran/src/H5match_types.c
View File

@ -533,7 +533,21 @@ int main(void)
/* double_f */
#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND
writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND);
if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */
writeFloatToFiles("Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND);
} else {
#if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */
writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND);
}
#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */
writeFloatToFiles("Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND);
}
#else
/* Error: couldn't find a size for double_f when fortran has 16 byte reals */
return -1;
}
#endif
#elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND
writeFloatToFiles("Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND);
#else
@ -541,6 +555,14 @@ int main(void)
return -1;
#endif
/* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03'
* in order to be interoperable with C's structure, the C buffer size
* H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4)
*/
fprintf(fort_header, " INTEGER, PARAMETER :: H5R_DSET_REG_REF_BUF_SIZE_F = %u\n", H5_SIZEOF_HADDR_T + 4 );
/* Close files */
endCfile();
endFfile();

2
fortran/src/hdf5_fortrandll.def
View File

@ -429,7 +429,9 @@ H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F
H5R_PROVISIONAL_mp_H5RCREATE_REGION_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_OBJECT_F
H5R_PROVISIONAL_mp_H5RDEREFERENCE_REGION_F
H5R_PROVISIONAL_mp_H5RGET_REGION_PTR_F
H5R_mp_H5RGET_REGION_REGION_F
H5R_mp_H5RGET_OBJECT_TYPE_OBJ_F
H5R_PROVISIONAL_mp_H5RGET_NAME_OBJECT_F
H5R_PROVISIONAL_mp_H5RGET_NAME_REGION_F

141
fortran/test/fortranlib_test_1_8.f90
View File

@ -93,12 +93,6 @@ PROGRAM fortranlibtest
' Testing dataspace encoding and decoding', &
total_error)
ret_total_error = 0
CALL test_nbit(cleanup, ret_total_error )
CALL write_test_status(ret_total_error, &
' Testing nbit filter', &
total_error)
ret_total_error = 0
CALL test_scaleoffset(cleanup, ret_total_error )
CALL write_test_status(ret_total_error, &
@ -400,141 +394,6 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
END SUBROUTINE test_h5s_encode
!-------------------------------------------------------------------------
! Function: test_nbit
!
! Purpose: Tests (real) datatype for nbit filter
!
! Return: Success: 0
! Failure: >0
!
! Programmer: M. Scot Breitenfeld
! Decemeber 7, 2010
!
! Modifications:
!
!-------------------------------------------------------------------------
!
SUBROUTINE test_nbit(cleanup, total_error )
USE HDF5
IMPLICIT NONE
INTEGER, PARAMETER :: wp = KIND(1.0)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: file
INTEGER(hid_t) :: dataset, datatype, space, dc
INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
! orig_data[] are initialized to be within the range that can be represented by
! dataset datatype (no precision loss during datatype conversion)
!
REAL(kind=wp), DIMENSION(1:2,1:5) :: orig_data = RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
REAL(kind=wp), DIMENSION(1:2,1:5) :: new_data
INTEGER(size_t) :: PRECISION, offset
INTEGER :: error
LOGICAL :: status
INTEGER*8 :: ii
INTEGER(size_t) :: i, j
! check to see if filter is available
CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
total_error = -1 ! so return
RETURN
ENDIF
CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
CALL check("H5Fcreate_f", error, total_error)
! Define dataset datatype (integer), and set precision, offset
CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
CALL CHECK(" H5Tcopy_f", error, total_error)
CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
CALL CHECK(" H5Tset_fields_f", error, total_error)
offset = 7
CALL H5Tset_offset_f(datatype, offset, error)
CALL CHECK(" H5Tset_offset_f", error, total_error)
PRECISION = 20
CALL H5Tset_precision_f(datatype,PRECISION, error)
CALL CHECK(" H5Tset_precision_f", error, total_error)
CALL H5Tset_size_f(datatype, 4_size_t, error)
CALL CHECK(" H5Tset_size_f", error, total_error)
CALL H5Tset_ebias_f(datatype, 31_size_t, error)
CALL CHECK(" H5Tset_ebias_f", error, total_error)
! Create the data space
CALL H5Screate_simple_f(2, dims, space, error)
CALL CHECK(" H5Screate_simple_f", error, total_error)
! USE nbit filter
CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
CALL CHECK(" H5Pcreate_f", error, total_error)
CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
CALL CHECK(" H5Pset_chunk_f", error, total_error)
CALL H5Pset_nbit_f(dc, error)
CALL CHECK(" H5Pset_nbit_f", error, total_error)
! Create the dataset
CALL H5Dcreate_f(file, "nbit_real", datatype, &
space, dataset, error, dc)
CALL CHECK(" H5Dcreate_f", error, total_error)
!----------------------------------------------------------------------
! STEP 1: Test nbit by setting up a chunked dataset and writing
! to it.
!----------------------------------------------------------------------
!
CALL H5Dwrite_f(dataset, H5T_NATIVE_REAL, orig_data, dims, error)
CALL CHECK(" H5Dwrite_f", error, total_error)
!----------------------------------------------------------------------
! STEP 2: Try to read the data we just wrote.
!----------------------------------------------------------------------
!
CALL H5Dread_f(dataset, H5T_NATIVE_REAL, new_data, dims, error)
CALL CHECK(" H5Dread_f", error, total_error)
! Check that the values read are the same as the values written
! Assume size of long long = size of double
!
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
IF(new_data(i,j) .NE. orig_data(i,j))THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
EXIT i_loop
END IF
ENDDO j_loop
ENDDO i_loop
!----------------------------------------------------------------------
! Cleanup
!----------------------------------------------------------------------
!
CALL H5Tclose_f(datatype, error)
CALL CHECK(" H5Tclose_f", error, total_error)
CALL H5Pclose_f(dc, error)
CALL CHECK(" H5Pclose_f", error, total_error)
CALL H5Sclose_f(space, error)
CALL CHECK(" H5Sclose_f", error, total_error)
CALL H5Dclose_f(dataset, error)
CALL CHECK(" H5Dclose_f", error, total_error)
CALL H5Fclose_f(file, error)
CALL CHECK(" H5Fclose_f", error, total_error)
END SUBROUTINE test_nbit
!-------------------------------------------------------------------------
! Function: test_scaleoffset
!

5
fortran/test/fortranlib_test_F03.f90
View File

@ -139,6 +139,11 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_iter_group(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error)
ret_total_error = 0
CALL test_nbit(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error)
! write(*,*)
! write(*,*) '========================================='

4
fortran/test/tH5A.f90
View File

@ -100,7 +100,7 @@
CHARACTER(LEN=35), DIMENSION(2) :: aread_data ! Buffer to put read back
! string attr data
CHARACTER :: attr_character_data = 'A'
DOUBLE PRECISION, DIMENSION(1) :: attr_double_data = 3.459
REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: attr_double_data = 3.459
REAL, DIMENSION(1) :: attr_real_data = 4.0
INTEGER, DIMENSION(1) :: attr_integer_data = 5
INTEGER(HSIZE_T), DIMENSION(7) :: data_dims
@ -109,7 +109,7 @@
CHARACTER :: aread_character_data ! variable to put read back Character attr data
INTEGER, DIMENSION(1) :: aread_integer_data ! variable to put read back integer attr data
INTEGER, DIMENSION(1) :: aread_null_data = 7 ! variable to put read back null attr data
DOUBLE PRECISION, DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
REAL(KIND=Fortran_DOUBLE), DIMENSION(1) :: aread_double_data ! variable to put read back double attr data
REAL, DIMENSION(1) :: aread_real_data ! variable to put read back real attr data
!

4
fortran/test/tH5T.f90
View File

@ -86,8 +86,8 @@
CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out
INTEGER, DIMENSION(dimsize) :: int_member
INTEGER, DIMENSION(dimsize) :: int_member_out
DOUBLE PRECISION, DIMENSION(dimsize) :: double_member
DOUBLE PRECISION, DIMENSION(dimsize) :: double_member_out
REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member
REAL(KIND=Fortran_DOUBLE), DIMENSION(dimsize) :: double_member_out
REAL, DIMENSION(dimsize) :: real_member
REAL, DIMENSION(dimsize) :: real_member_out
INTEGER :: i

158
fortran/test/tH5T_F03.f90
View File

@ -1976,8 +1976,8 @@ SUBROUTINE t_regref(total_error)
INTEGER(HSIZE_T), DIMENSION(1:1) :: maxdims
INTEGER(hssize_t) :: npoints
TYPE(hdset_reg_ref_t_f), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
TYPE(hdset_reg_ref_t_f), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
TYPE(hdset_reg_ref_t_f03), DIMENSION(1:dim0), TARGET :: wdata ! Write buffer
TYPE(hdset_reg_ref_t_f03), DIMENSION(:), ALLOCATABLE, TARGET :: rdata ! Read buffer
INTEGER(size_t) :: size
CHARACTER(LEN=1), DIMENSION(1:ds2dim0,1:ds2dim1), TARGET :: wdata2
@ -2058,7 +2058,6 @@ SUBROUTINE t_regref(total_error)
CALL check("h5sclose_f",error, total_error)
CALL h5fclose_f(file , error)
CALL check("h5fclose_f",error, total_error)
!
! Now we begin the read section of this example.
!
@ -2095,10 +2094,11 @@ SUBROUTINE t_regref(total_error)
! Open the referenced object, retrieve its region as a
! dataspace selection.
!
CALL H5Rdereference_f(dset, rdata(i), dset2, error)
f_ptr = C_LOC(rdata(i))
CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error)
CALL check("H5Rdereference_f",error, total_error)
CALL H5Rget_region_f(dset, rdata(i), space, error)
CALL H5Rget_region_f(dset, f_ptr, space, error)
CALL check("H5Rget_region_f",error, total_error)
!
@ -2754,7 +2754,7 @@ SUBROUTINE t_string(total_error)
CALL check("H5Dget_type_f",error, total_error)
CALL H5Tget_size_f(filetype, size, error)
CALL check("H5Tget_size_f",error, total_error)
CALL VERIFY("H5Tget_size_f", size, sdim, total_error)
CALL VERIFY("H5Tget_size_f", INT(size), INT(sdim), total_error)
!
! Get dataspace.
!
@ -2801,3 +2801,149 @@ SUBROUTINE t_string(total_error)
END SUBROUTINE t_string
!-------------------------------------------------------------------------
! Function: test_nbit
!
! Purpose: Tests (real, 4 byte) datatype for nbit filter
!
! Return: Success: 0
! Failure: >0
!
! Programmer: M. Scot Breitenfeld
! Decemeber 7, 2010
!
! Modifications: Moved this subroutine from the 1.8 test file and
! modified it to use F2003 features.
! This routine requires 4 byte reals, so we use F2003 features to
! ensure the requirement is satisfied in a portable way.
! The need for this arises when a user specifies the default real is 8 bytes.
! MSB 7/31/12
!
!-------------------------------------------------------------------------
!
SUBROUTINE test_nbit(cleanup, total_error )
USE HDF5
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: file
INTEGER(hid_t) :: dataset, datatype, space, dc, mem_type_id
INTEGER(hsize_t), DIMENSION(1:2) :: dims = (/2,5/)
INTEGER(hsize_t), DIMENSION(1:2) :: chunk_dim = (/2,5/)
! orig_data[] are initialized to be within the range that can be represented by
! dataset datatype (no precision loss during datatype conversion)
!
REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: orig_data = &
RESHAPE( (/188384.00, 19.103516, -1.0831790e9, -84.242188, &
5.2045898, -49140.000, 2350.2500, -3.2110596e-1, 6.4998865e-5, -0.0000000/) , (/2,5/) )
REAL(kind=wp), DIMENSION(1:2,1:5), TARGET :: new_data
INTEGER(size_t) :: PRECISION, offset
INTEGER :: error
LOGICAL :: status
INTEGER(size_t) :: i, j
TYPE(C_PTR) :: f_ptr
! check to see if filter is available
CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
IF(.NOT.status)THEN ! We don't have H5Z_FILTER_NBIT_F filter
total_error = -1 ! so return
RETURN
ENDIF
CALL H5Fcreate_f("nbit.h5", H5F_ACC_TRUNC_F, file, error)
CALL check("H5Fcreate_f", error, total_error)
! Define dataset datatype (integer), and set precision, offset
CALL H5Tcopy_f(H5T_IEEE_F32BE, datatype, error)
CALL CHECK(" H5Tcopy_f", error, total_error)
CALL H5Tset_fields_f(datatype, 26_size_t, 20_size_t, 6_size_t, 7_size_t, 13_size_t, error)
CALL CHECK(" H5Tset_fields_f", error, total_error)
offset = 7
CALL H5Tset_offset_f(datatype, offset, error)
CALL CHECK(" H5Tset_offset_f", error, total_error)
PRECISION = 20
CALL H5Tset_precision_f(datatype,PRECISION, error)
CALL CHECK(" H5Tset_precision_f", error, total_error)
CALL H5Tset_size_f(datatype, 4_size_t, error)
CALL CHECK(" H5Tset_size_f", error, total_error)
CALL H5Tset_ebias_f(datatype, 31_size_t, error)
CALL CHECK(" H5Tset_ebias_f", error, total_error)
! Create the data space
CALL H5Screate_simple_f(2, dims, space, error)
CALL CHECK(" H5Screate_simple_f", error, total_error)
! USE nbit filter
CALL H5Pcreate_f(H5P_DATASET_CREATE_F, dc, error)
CALL CHECK(" H5Pcreate_f", error, total_error)
CALL H5Pset_chunk_f(dc, 2, chunk_dim, error)
CALL CHECK(" H5Pset_chunk_f", error, total_error)
CALL H5Pset_nbit_f(dc, error)
CALL CHECK(" H5Pset_nbit_f", error, total_error)
! Create the dataset
CALL H5Dcreate_f(file, "nbit_real", datatype, &
space, dataset, error, dc)
CALL CHECK(" H5Dcreate_f", error, total_error)
!----------------------------------------------------------------------
! STEP 1: Test nbit by setting up a chunked dataset and writing
! to it.
!----------------------------------------------------------------------
!
mem_type_id = h5kind_to_type(wp,H5_REAL_KIND)
f_ptr = C_LOC(orig_data(1,1))
CALL H5Dwrite_f(dataset, mem_type_id, f_ptr, error)
CALL CHECK(" H5Dwrite_f", error, total_error)
!----------------------------------------------------------------------
! STEP 2: Try to read the data we just wrote.
!----------------------------------------------------------------------
!
f_ptr = C_LOC(new_data(1,1))
CALL H5Dread_f(dataset, mem_type_id, f_ptr, error)
CALL CHECK(" H5Dread_f", error, total_error)
! Check that the values read are the same as the values written
! Assume size of long long = size of double
!
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
IF(new_data(i,j) .NE. orig_data(i,j))THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
EXIT i_loop
END IF
ENDDO j_loop
ENDDO i_loop
!----------------------------------------------------------------------
! Cleanup
!----------------------------------------------------------------------
!
CALL H5Tclose_f(datatype, error)
CALL CHECK(" H5Tclose_f", error, total_error)
CALL H5Pclose_f(dc, error)
CALL CHECK(" H5Pclose_f", error, total_error)
CALL H5Sclose_f(space, error)
CALL CHECK(" H5Sclose_f", error, total_error)
CALL H5Dclose_f(dataset, error)
CALL CHECK(" H5Dclose_f", error, total_error)
CALL H5Fclose_f(file, error)
CALL CHECK(" H5Fclose_f", error, total_error)
END SUBROUTINE test_nbit