diff options
Diffstat (limited to 'fortran')
| -rw-r--r-- | fortran/src/H5Df.c | 45 | ||||
| -rw-r--r-- | fortran/src/H5Dff.F90 | 95 | ||||
| -rw-r--r-- | fortran/src/H5f90proto.h | 2 | ||||
| -rw-r--r-- | fortran/src/hdf5_fortrandll.def.in | 6 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.F90 | 6 | ||||
| -rw-r--r-- | fortran/test/tH5D.F90 | 309 |
6 files changed, 393 insertions, 70 deletions
diff --git a/fortran/src/H5Df.c b/fortran/src/H5Df.c index ba3e5d4..75dd014 100644 --- a/fortran/src/H5Df.c +++ b/fortran/src/H5Df.c @@ -1047,51 +1047,6 @@ DONE: return ret_value; } -/****if* H5Df/h5dfill_c - * NAME - * h5dfill_c - * PURPOSE - * Call H5Dfill to fill memory buffer with a fill value - * INPUTS - * fill_value - fill value - * fill_type_id - fill value datatype identifier - * space_id - memory space selection identifier - * buf - memory buffer to fill - * mem_type_id - memory buffer dtatype identifier - * RETURNS - * 0 on success, -1 on failure - * AUTHOR - * Elena Pourmal - * Wednesday, March 12, 2003 - * HISTORY - * - * SOURCE - */ -int_f -h5dfill_c(void *fill_value, hid_t_f *fill_type_id, hid_t_f *space_id, void *buf, hid_t_f *mem_type_id) -/******/ -{ - int ret_value = -1; - herr_t ret; - hid_t c_fill_type_id; - hid_t c_mem_type_id; - hid_t c_space_id; - - c_fill_type_id = (hid_t)*fill_type_id; - c_mem_type_id = (hid_t)*mem_type_id; - c_space_id = (hid_t)*space_id; - - /* - * Call H5Dfill function. - */ - ret = H5Dfill(fill_value, c_fill_type_id, buf, c_mem_type_id, c_space_id); - - if (ret < 0) - return ret_value; - ret_value = 0; - return ret_value; -} - /****if* H5Df/h5dget_space_status_c * NAME * h5dget_space_status_c diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 0da0092..1a2c9f3 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -93,7 +93,7 @@ MODULE H5D PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string PRIVATE h5dwrite_reference_obj, h5dwrite_reference_dsetreg, h5dwrite_char_scalar, h5dwrite_ptr PRIVATE h5dread_reference_obj, h5dread_reference_dsetreg, h5dread_char_scalar, h5dread_ptr - PRIVATE h5dfill_integer, h5dfill_c_float, h5dfill_c_double, h5dfill_char + PRIVATE h5dfill_integer, h5dfill_c_float, h5dfill_c_double, h5dfill_char, h5dfill_ptr #if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 PRIVATE h5dfill_c_long_double #endif @@ -183,6 +183,7 @@ MODULE H5D MODULE PROCEDURE h5dfill_c_long_double #endif MODULE PROCEDURE h5dfill_char + MODULE PROCEDURE h5dfill_ptr END INTERFACE ! Interface for the function used to pass the C pointer of the buffer @@ -1220,6 +1221,8 @@ CONTAINS !! Only INTEGER, CHARACTER, REAL and DOUBLE PRECISION datatypes of the fillvalues and buffers are supported. !! Buffer and fillvalue are assumed to have the same datatype. Only one-dimesional buffers are supported. !! +!! \attention \fortran_obsolete +!! !! \param fill_value Fill value. !! \param space_id Identifier of the memory datatype. !! \param buf Buffer to receive data read from file. @@ -1233,6 +1236,31 @@ CONTAINS TYPE(TYPE), INTENT(OUT), DIMENSION(*) :: buf INTEGER, INTENT(OUT) :: hdferr END SUBROUTINE h5dfill_f +!> +!! \ingroup FH5D +!! +!! \brief Fills dataspace elements with a fill value in a memory buffer. +!! +!! \attention \fortran_approved +!! +!! \param fill_value Pointer to the fill value to be used. +!! \param fill_type_id Fill value datatype identifier, +!! \param buf Pointer to the memory buffer containing the selection to be filled. +!! \param buf_type_id Datatype of dataspace elements to be filled. +!! \param space_id Dataspace identifier. +!! \param hdferr \fortran_error +!! +!! See C API: @ref herr_t H5Dfill(const void *fill, hid_t fill_type_id, void *buf, hid_t buf_type_id, hid_t space_id); +!! + SUBROUTINE h5dfill_f(fill_value, fill_type_id, buf, buf_type_id, space_id, hdferr) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + IMPLICIT NONE + TYPE(C_PTR) :: fill_value + INTEGER(HID_T), INTENT(IN) :: fill_type_id + TYPE(C_PTR) :: buf + INTEGER(HID_T), INTENT(IN) :: buf_type_id + INTEGER(HID_T), INTENT(IN) :: space_id + END SUBROUTINE h5dfill_f #else @@ -1587,12 +1615,39 @@ CONTAINS END SUBROUTINE h5dread_ptr + SUBROUTINE h5dfill_ptr(fill_value, fill_type_id, buf, buf_type_id, space_id, hdferr) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR + IMPLICIT NONE + TYPE(C_PTR) :: fill_value + INTEGER(HID_T), INTENT(IN) :: fill_type_id + TYPE(C_PTR) :: buf + INTEGER(HID_T), INTENT(IN) :: buf_type_id + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER FUNCTION h5dfill(fill_value, fill_type_id, buf, buf_type_id, space_id) & + BIND(C,NAME='H5Dfill') + IMPORT :: HID_T, C_PTR + IMPLICIT NONE + TYPE(C_PTR) , VALUE :: fill_value + INTEGER(HID_T), VALUE :: fill_type_id + TYPE(C_PTR) , VALUE :: buf + INTEGER(HID_T), VALUE :: buf_type_id + INTEGER(HID_T), VALUE :: space_id + END FUNCTION h5dfill + END INTERFACE + + hdferr = INT(h5dfill(fill_value, fill_type_id, buf, buf_type_id, space_id)) + + END SUBROUTINE h5dfill_ptr + SUBROUTINE h5dfill_integer(fill_value, space_id, buf, hdferr) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE INTEGER, INTENT(IN), TARGET :: fill_value ! Fill value INTEGER(HID_T), INTENT(IN) :: space_id ! Memory dataspace selection identifier - INTEGER, INTENT(IN), DIMENSION(*), TARGET :: buf ! Memory buffer to fill in + INTEGER, INTENT(OUT), DIMENSION(*), TARGET :: buf ! Memory buffer to fill in INTEGER, INTENT(OUT) :: hdferr ! Error code INTEGER(HID_T) :: fill_type_id ! Fill value datatype identifier @@ -1607,15 +1662,14 @@ CONTAINS fill_type_id = H5T_NATIVE_INTEGER mem_type_id = H5T_NATIVE_INTEGER - hdferr = h5dfill_c(f_ptr_fill_value, fill_type_id, space_id, & - f_ptr_buf, mem_type_id) + CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) END SUBROUTINE h5dfill_integer - SUBROUTINE h5dfill_c_float(fill_valuer, space_id, buf, hdferr) + SUBROUTINE h5dfill_c_float(fill_value, space_id, buf, hdferr) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE - REAL(KIND=C_FLOAT), INTENT(IN), TARGET :: fill_valuer + REAL(KIND=C_FLOAT), INTENT(IN), TARGET :: fill_value INTEGER(HID_T), INTENT(IN) :: space_id REAL(KIND=C_FLOAT), INTENT(OUT), DIMENSION(*), TARGET :: buf INTEGER, INTENT(OUT) :: hdferr @@ -1623,17 +1677,16 @@ CONTAINS INTEGER(HID_T) :: fill_type_id ! Fill value datatype identifier INTEGER(HID_T) :: mem_type_id ! Buffer dadtype identifier - TYPE(C_PTR) :: f_ptr_fill_valuer ! C pointer to fill_value + TYPE(C_PTR) :: f_ptr_fill_value ! C pointer to fill_value TYPE(C_PTR) :: f_ptr_buf ! C pointer to buf - f_ptr_fill_valuer = C_LOC(fill_valuer) + f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) fill_type_id = H5T_NATIVE_REAL mem_type_id = H5T_NATIVE_REAL - hdferr = h5dfill_c(f_ptr_fill_valuer, fill_type_id, space_id, & - f_ptr_buf, mem_type_id) + CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) END SUBROUTINE h5dfill_c_float @@ -1647,17 +1700,16 @@ CONTAINS INTEGER(HID_T) :: fill_type_id ! Fill value datatype identifier INTEGER(HID_T) :: mem_type_id ! Buffer dadtype identifier - TYPE(C_PTR) :: f_ptr_fill_valuer ! C pointer to fill_value + TYPE(C_PTR) :: f_ptr_fill_value ! C pointer to fill_value TYPE(C_PTR) :: f_ptr_buf ! C pointer to buf - f_ptr_fill_valuer = C_LOC(fill_value) + f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) fill_type_id = H5T_NATIVE_DOUBLE mem_type_id = H5T_NATIVE_DOUBLE - hdferr = h5dfill_c(f_ptr_fill_valuer, fill_type_id, space_id, & - f_ptr_buf, mem_type_id) + CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) END SUBROUTINE h5dfill_c_double @@ -1672,22 +1724,21 @@ CONTAINS INTEGER(HID_T) :: fill_type_id ! Fill value datatype identifier INTEGER(HID_T) :: mem_type_id ! Buffer dadtype identifier - TYPE(C_PTR) :: f_ptr_fill_valuer ! C pointer to fill_value + TYPE(C_PTR) :: f_ptr_fill_value ! C pointer to fill_value TYPE(C_PTR) :: f_ptr_buf ! C pointer to buf - f_ptr_fill_valuer = C_LOC(fill_value) + f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) fill_type_id = H5T_NATIVE_DOUBLE mem_type_id = H5T_NATIVE_DOUBLE - hdferr = h5dfill_c(f_ptr_fill_valuer, fill_type_id, space_id, & - f_ptr_buf, mem_type_id) + CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) END SUBROUTINE h5dfill_c_long_double #endif - SUBROUTINE h5dfill_char(fill_value, space_id, buf, hdferr) + SUBROUTINE h5dfill_char(fill_value, space_id, buf, hdferr) USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR IMPLICIT NONE CHARACTER, INTENT(IN), TARGET :: fill_value @@ -1704,8 +1755,10 @@ CONTAINS f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) - hdferr = h5dfill_c(f_ptr_fill_value, fill_type_id, space_id, & - f_ptr_buf, mem_type_id) + fill_type_id = H5T_NATIVE_CHARACTER + mem_type_id = H5T_NATIVE_CHARACTER + + CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) END SUBROUTINE h5dfill_char diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 3cfba71..1a9a854 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -175,8 +175,6 @@ H5_FCDLL int_f h5dget_create_plist_c(hid_t_f *dset_id, hid_t_f *plist_id); H5_FCDLL int_f h5dset_extent_c(hid_t_f *dset_id, hsize_t_f *dims); H5_FCDLL int_f h5dvlen_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 h5dget_storage_size_c(hid_t_f *dataset_id, hsize_t_f *size); -H5_FCDLL int_f h5dfill_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 h5dget_space_status_c(hid_t_f *dset_id, int_f *flag); H5_FCDLL int_f h5dcreate_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); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index f61f74b..7743579 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -61,8 +61,12 @@ H5D_mp_H5DWRITE_VL_REAL H5D_mp_H5DREAD_VL_REAL H5D_mp_H5DWRITE_VL_STRING H5D_mp_H5DREAD_VL_STRING -H5D_mp_H5DFILL_CHAR +H5D_mp_H5DFILL_PTR H5D_mp_H5DFILL_INTEGER +H5D_mp_H5DFILL_C_FLOAT +H5D_mp_H5DFILL_C_DOUBLE +H5D_mp_H5DFILL_C_LONG_DOUBLE +H5D_mp_H5DFILL_CHAR H5D_mp_H5DGET_SPACE_STATUS_F H5D_mp_H5DCREATE_ANON_F H5D_mp_H5DGET_OFFSET_F diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index 998b481..049d381 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -106,9 +106,15 @@ PROGRAM fortranlibtest CALL extenddsettest(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Extendible dataset test', total_error) + ret_total_error = 0 CALL test_userblock_offset(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Dataset offset with user block', total_error) + ! Test filling dataspace elements + ret_total_error = 0 + CALL test_dset_fill(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Filling dataspace elements', total_error) + ! ! '=========================================' ! 'Testing DATASPACE Interface ' diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index 5f8484e..6e19ca4 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -332,7 +332,7 @@ CONTAINS ! !Create the data space with unlimited dimensions. ! - maxdims = (/H5S_UNLIMITED_F, H5S_UNLIMITED_F/) + maxdims(1:2) = H5S_UNLIMITED_F CALL h5screate_simple_f(RANK, dims, dataspace, error, maxdims) CALL check("h5screate_simple_f",error,total_error) @@ -628,5 +628,312 @@ CONTAINS END SUBROUTINE test_userblock_offset + SUBROUTINE test_dset_fill(cleanup, total_error) + + USE ISO_C_BINDING + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + + INTEGER, PARAMETER :: DIM0=10 + INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors + INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors + INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors + INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors + INTEGER(KIND=int_kind_1) , DIMENSION(1:DIM0), TARGET :: data_i1 + INTEGER(KIND=int_kind_4) , DIMENSION(1:DIM0), TARGET :: data_i4 + INTEGER(KIND=int_kind_8) , DIMENSION(1:DIM0), TARGET :: data_i8 + INTEGER(KIND=int_kind_16), DIMENSION(1:DIM0), TARGET :: data_i16 + INTEGER(KIND=int_kind_1) , TARGET :: data0_i1 = 4 + INTEGER(KIND=int_kind_4) , TARGET :: data0_i4 = 4 + INTEGER(KIND=int_kind_8) , TARGET :: data0_i8 = 4 + INTEGER(KIND=int_kind_16), TARGET :: data0_i16 = 4 +#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 + INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors + INTEGER(KIND=int_kind_32), DIMENSION(1:DIM0), TARGET :: data_i32 + INTEGER(KIND=int_kind_16), TARGET :: data0_i32 = 4 +#endif + INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors + INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE !should map to REAL*8 on most modern processors + REAL(KIND=real_kind_7) , DIMENSION(1:DIM0), TARGET :: data_r7 + REAL(KIND=real_kind_15), DIMENSION(1:DIM0), TARGET :: data_r15 + REAL(KIND=real_kind_7) , TARGET :: data0_r7 = 4.0 + REAL(KIND=real_kind_15), TARGET :: data0_r15 = 4.0 + + INTEGER :: i + CHARACTER , DIMENSION(1:DIM0), TARGET :: data_chr + CHARACTER , TARGET :: data0_chr = "h" + INTEGER(hsize_t), DIMENSION(1:1) :: dims + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: fill_type_id + INTEGER(HID_T) :: buf_type_id + INTEGER(hssize_t), DIMENSION(1:1) :: ioffset + INTEGER(hsize_t), DIMENSION(1:1) :: icount + INTEGER :: error + TYPE(C_PTR) :: f_ptr1, f_ptr2 + + ! Initialize memory buffer + data_i1 = -2 + data_i4 = -2 + data_i8 = -2 + data_i16 = -2 +#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 + data_i32 = -2 +#endif + data_r7 = -2.0_real_kind_7 + data_r15 = -2.0_real_kind_15 + data_chr = "H" + + dims(1) = DIM0 + ioffset(1) = 0 + icount(1) = DIM0/2 + + CALL h5screate_simple_f(1, dims, space_id, error) + CALL check("h5screate_simple_f",error,total_error) + + CALL h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, ioffset, icount, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + !********************************************************* + ! TEST LEGACY H5Dfill_f APIs + !********************************************************* + + CALL h5dfill_f(data0_i8, space_id, data_i8, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i8, data_i8(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_8, data_i8(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + CALL h5dfill_f(data0_r7, space_id, data_r7, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_r7, data_r7(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2.0_real_kind_7, data_r7(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + CALL h5dfill_f(data0_r15, space_id, data_r15, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_r15, data_r15(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2.0_real_kind_15, data_r15(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + CALL h5dfill_f(data0_chr, space_id, data_chr, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_chr, data_chr(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", "H", data_chr(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + CALL h5dfill_f(data0_i32, space_id, data_i32, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i32, data_i32(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I32)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_32, data_i32(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I32)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO +#endif + + !********************************************************* + ! TEST MODERN H5Dfill_f APIs + !********************************************************* + + ! Initialize memory buffer + data_i1 = -2 + data_i4 = -2 + data_i8 = -2 + data_i16 = -2 +#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 + data_i32 = -2 +#endif + data_r7 = -2.0_real_kind_7 + data_r15 = -2.0_real_kind_15 + data_chr = "H" + + ! Test spectrum of datatype types + + f_ptr1 = C_LOC(data0_i1) + f_ptr2 = C_LOC(data_i1(1)) + + fill_type_id = h5kind_to_type(KIND(data0_i1), H5_INTEGER_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i1, data_i1(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I1)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_1, data_i1(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I1)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + f_ptr1 = C_LOC(data0_i4) + f_ptr2 = C_LOC(data_i4(1)) + + fill_type_id = h5kind_to_type(KIND(data0_i4), H5_INTEGER_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i4, data_i4(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_4, data_i4(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + f_ptr1 = C_LOC(data0_i16) + f_ptr2 = C_LOC(data_i16(1)) + + fill_type_id = h5kind_to_type(KIND(data0_i16), H5_INTEGER_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i16, data_i16(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I16)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_16, data_i16(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I16)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + f_ptr1 = C_LOC(data0_chr) + f_ptr2 = C_LOC(data_chr(1)) + + fill_type_id = H5T_NATIVE_CHARACTER + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_chr, data_chr(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ELSE + CALL VERIFY("h5dfill_f", "H", data_chr(i), total_error) + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDIF + ENDDO + + + END SUBROUTINE test_dset_fill + END MODULE TH5D |