summaryrefslogtreecommitdiffstats
path: root/hl
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-09-10 21:18:17 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-09-10 21:18:17 (GMT)
commit672e6bd8a9e666df50f54531a95cdff8dfd4f5c1 (patch)
tree0164e8e30fb521045b108a01477bc35f66b63151 /hl
parent54d0a3694785431dee7a46cab56694cf6ba9bde2 (diff)
downloadhdf5-672e6bd8a9e666df50f54531a95cdff8dfd4f5c1.zip
hdf5-672e6bd8a9e666df50f54531a95cdff8dfd4f5c1.tar.gz
hdf5-672e6bd8a9e666df50f54531a95cdff8dfd4f5c1.tar.bz2
[svn-r27754] HDFFV-548:H5LT patches for F90 Lite API in 1.8.0 Beta
tested: h5committest
Diffstat (limited to 'hl')
-rw-r--r--hl/fortran/src/H5HL_buildiface.F90179
-rw-r--r--hl/fortran/src/H5LTff.F9034
-rw-r--r--hl/fortran/test/tstlite.F901273
3 files changed, 910 insertions, 576 deletions
diff --git a/hl/fortran/src/H5HL_buildiface.F90 b/hl/fortran/src/H5HL_buildiface.F90
index 0e85e27..9dd879c 100644
--- a/hl/fortran/src/H5HL_buildiface.F90
+++ b/hl/fortran/src/H5HL_buildiface.F90
@@ -83,13 +83,13 @@ PROGRAM H5HL_buildiface
/)
! pointer to the buffer
CHARACTER(LEN=37), DIMENSION(1:8), PARAMETER :: f_ptr_line=(/ &
- ' f_ptr = C_LOC(buf) ', &
- ' f_ptr = C_LOC(buf(1)) ', &
- ' f_ptr = C_LOC(buf(1,1)) ', &
- ' f_ptr = C_LOC(buf(1,1,1)) ', &
- ' f_ptr = C_LOC(buf(1,1,1,1)) ', &
- ' f_ptr = C_LOC(buf(1,1,1,1,1)) ', &
- ' f_ptr = C_LOC(buf(1,1,1,1,1,1)) ', &
+ ' f_ptr = C_LOC(buf )', &
+ ' f_ptr = C_LOC(buf(1) )', &
+ ' f_ptr = C_LOC(buf(1,1) )', &
+ ' f_ptr = C_LOC(buf(1,1,1) )', &
+ ' f_ptr = C_LOC(buf(1,1,1,1) )', &
+ ' f_ptr = C_LOC(buf(1,1,1,1,1) )', &
+ ' f_ptr = C_LOC(buf(1,1,1,1,1,1) )', &
' f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' &
/)
@@ -154,6 +154,13 @@ PROGRAM H5HL_buildiface
WRITE(11,'(A)') " MODULE PROCEDURE h5ltmake_dataset_real_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
ENDDO
END DO
+ DO i = 1, num_ikinds
+ j = ikind(i)
+ WRITE(chr2,'(I2)') j
+ DO k = 1, 8
+ WRITE(11,'(A)') " MODULE PROCEDURE h5ltmake_dataset_integer_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
+ ENDDO
+ END DO
WRITE(11,'(A)') " END INTERFACE"
! h5ltread_dataset_f
@@ -165,6 +172,35 @@ PROGRAM H5HL_buildiface
WRITE(11,'(A)') " MODULE PROCEDURE h5ltread_dataset_real_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
ENDDO
END DO
+ DO i = 1, num_ikinds
+ j = ikind(i)
+ WRITE(chr2,'(I2)') j
+ DO k = 1, 8
+ WRITE(11,'(A)') " MODULE PROCEDURE h5ltread_dataset_integer_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
+ ENDDO
+ END DO
+ WRITE(11,'(A)') " END INTERFACE"
+
+! h5ltread_dataset_int_f
+ WRITE(11,'(A)') " INTERFACE h5ltread_dataset_int_f"
+ DO i = 1, num_ikinds
+ j = ikind(i)
+ WRITE(chr2,'(I2)') j
+ DO k = 1, 8
+ WRITE(11,'(A)') " MODULE PROCEDURE h5ltread_dataset_int_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
+ ENDDO
+ END DO
+ WRITE(11,'(A)') " END INTERFACE"
+
+! h5ltmake_dataset_int_f
+ WRITE(11,'(A)') " INTERFACE h5ltmake_dataset_int_f"
+ DO i = 1, num_ikinds
+ j = ikind(i)
+ WRITE(chr2,'(I2)') j
+ DO k = 1, 8
+ WRITE(11,'(A)') " MODULE PROCEDURE h5ltmake_dataset_int_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k)
+ ENDDO
+ END DO
WRITE(11,'(A)') " END INTERFACE"
! h5ltmake_dataset_float_f
@@ -346,7 +382,6 @@ PROGRAM H5HL_buildiface
k = rkind(i)
WRITE(chr2,'(I2)') k
DO j = 1, 8
-
! DLL definitions for windows
WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_HL_DLL)'
WRITE(11,'(A)') '!DEC$attributes dllexport :: h5ltmake_dataset_double_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
@@ -402,6 +437,134 @@ PROGRAM H5HL_buildiface
ENDDO
ENDDO
+! h5ltmake_dataset_f
+ DO i = 1, num_ikinds
+ k = ikind(i)
+ WRITE(chr2,'(I2)') k
+ DO j = 1, 8
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_HL_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: h5ltmake_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE h5ltmake_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))&
+ &//'_rank'//chr_rank(j)//'(loc_id,dset_name,rank,dims,type_id,buf,errcode)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' INTEGER(hid_t) , INTENT(IN) :: loc_id'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(IN) :: dset_name'
+ WRITE(11,'(A)') ' INTEGER, INTENT(IN) :: rank'
+ WRITE(11,'(A)') ' INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims'
+ WRITE(11,'(A)') ' INTEGER(hid_t), INTENT(in) :: type_id'
+ WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
+ WRITE(11,'(A)') ' INTEGER :: errcode '
+ WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr'
+ WRITE(11,'(A)') ' INTEGER(size_t) :: namelen'
+
+ WRITE(11,'(A)') f_ptr_line(j)
+ WRITE(11,'(A)') ' namelen = LEN(dset_name)'
+ WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id, namelen, dset_name, rank, dims, type_id, f_ptr)'
+ WRITE(11,'(A)') ' END SUBROUTINE h5ltmake_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ ENDDO
+ ENDDO
+
+! h5ltmake_dataset_int_f
+ DO i = 1, num_ikinds
+ k = ikind(i)
+ WRITE(chr2,'(I2)') k
+ DO j = 1, 8
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_HL_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: h5ltmake_dataset_int_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE h5ltmake_dataset_int_kind_'//TRIM(ADJUSTL(chr2))&
+ &//'_rank'//chr_rank(j)//'(loc_id,dset_name,rank,dims,buf,errcode)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' INTEGER(hid_t) , INTENT(IN) :: loc_id'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(IN) :: dset_name'
+ WRITE(11,'(A)') ' INTEGER, INTENT(IN) :: rank'
+ WRITE(11,'(A)') ' INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims'
+ WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
+ WRITE(11,'(A)') ' INTEGER :: errcode '
+ WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr'
+ WRITE(11,'(A)') ' INTEGER(size_t) :: namelen'
+ WRITE(11,'(A)') ' INTEGER(hid_t) :: type_id'
+
+ WRITE(11,'(A)') f_ptr_line(j)
+ WRITE(11,'(A)') ' namelen = LEN(dset_name)'
+ WRITE(11,'(A)') ' type_id = h5kind_to_type(KIND('//f_ptr_line(j)(19:36)//'), H5_INTEGER_KIND)'
+ WRITE(11,'(A)') ' errcode = h5ltmake_dataset_c(loc_id, namelen, dset_name, rank, dims, type_id, f_ptr)'
+ WRITE(11,'(A)') ' END SUBROUTINE h5ltmake_dataset_int_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ ENDDO
+ ENDDO
+
+! h5ltread_dataset_f
+ DO i = 1, num_ikinds
+ k = ikind(i)
+ WRITE(chr2,'(I2)') k
+ DO j = 1, 8
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_HL_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: h5ltread_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE h5ltread_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))&
+ &//'_rank'//chr_rank(j)//'(loc_id,dset_name, type_id, buf,dims,errcode)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' INTEGER(hid_t) , INTENT(IN) :: loc_id'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(IN) :: dset_name'
+ WRITE(11,'(A)') ' INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims'
+ WRITE(11,'(A)') ' INTEGER(hid_t), INTENT(in) :: type_id'
+ WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
+ WRITE(11,'(A)') ' INTEGER :: errcode '
+ WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr'
+ WRITE(11,'(A)') ' INTEGER(size_t) :: namelen'
+
+ WRITE(11,'(A)') f_ptr_line(j)
+ WRITE(11,'(A)') ' namelen = LEN(dset_name)'
+ WRITE(11,'(A)') ' errcode = h5ltread_dataset_c(loc_id, namelen, dset_name, type_id, f_ptr)'
+ WRITE(11,'(A)') ' END SUBROUTINE h5ltread_dataset_integer_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ ENDDO
+ ENDDO
+
+! h5ltread_dataset_int_f
+ DO i = 1, num_ikinds
+ k = ikind(i)
+ WRITE(chr2,'(I2)') k
+ DO j = 1, 8
+
+! DLL definitions for windows
+ WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_HL_DLL)'
+ WRITE(11,'(A)') '!DEC$attributes dllexport :: h5ltread_dataset_int_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ WRITE(11,'(A)') '!DEC$endif'
+
+! Subroutine API
+ WRITE(11,'(A)') ' SUBROUTINE h5ltread_dataset_int_kind_'//TRIM(ADJUSTL(chr2))&
+ &//'_rank'//chr_rank(j)//'(loc_id,dset_name, buf,dims,errcode)'
+ WRITE(11,'(A)') ' IMPLICIT NONE'
+ WRITE(11,'(A)') ' INTEGER(hid_t) , INTENT(IN) :: loc_id'
+ WRITE(11,'(A)') ' CHARACTER(LEN=*), INTENT(IN) :: dset_name'
+ WRITE(11,'(A)') ' INTEGER(hsize_t), DIMENSION(*), INTENT(in) :: dims'
+ WRITE(11,'(A)') ' INTEGER(KIND='//TRIM(ADJUSTL(chr2))//'),INTENT(IN)'//TRIM(rank_dim_line(j))//', TARGET :: buf'
+ WRITE(11,'(A)') ' INTEGER :: errcode '
+ WRITE(11,'(A)') ' TYPE(C_PTR) :: f_ptr'
+ WRITE(11,'(A)') ' INTEGER(size_t) :: namelen'
+ WRITE(11,'(A)') ' INTEGER(hid_t) :: type_id'
+
+ WRITE(11,'(A)') f_ptr_line(j)
+ WRITE(11,'(A)') ' namelen = LEN(dset_name)'
+ WRITE(11,'(A)') ' type_id = h5kind_to_type(KIND('//f_ptr_line(j)(19:36)//'), H5_INTEGER_KIND)'
+ WRITE(11,'(A)') ' errcode = h5ltread_dataset_c(loc_id, namelen, dset_name, type_id, f_ptr)'
+ WRITE(11,'(A)') ' END SUBROUTINE h5ltread_dataset_int_kind_'//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(j)
+ ENDDO
+ ENDDO
+
WRITE(11,'(A)') 'END MODULE H5LT' ! change this to be generic MSB
CLOSE(11)
diff --git a/hl/fortran/src/H5LTff.F90 b/hl/fortran/src/H5LTff.F90
index ffc7ab5..d36d92c 100644
--- a/hl/fortran/src/H5LTff.F90
+++ b/hl/fortran/src/H5LTff.F90
@@ -38,47 +38,13 @@ MODULE H5LT_CONST
USE hdf5
INTERFACE h5ltmake_dataset_f
- MODULE PROCEDURE h5ltmake_dataset_f_int1
- MODULE PROCEDURE h5ltmake_dataset_f_int2
- MODULE PROCEDURE h5ltmake_dataset_f_int3
- MODULE PROCEDURE h5ltmake_dataset_f_int4
- MODULE PROCEDURE h5ltmake_dataset_f_int5
- MODULE PROCEDURE h5ltmake_dataset_f_int6
- MODULE PROCEDURE h5ltmake_dataset_f_int7
MODULE PROCEDURE h5ltmake_dataset_f_ptr
END INTERFACE
INTERFACE h5ltread_dataset_f
- MODULE PROCEDURE h5ltread_dataset_f_int1
- MODULE PROCEDURE h5ltread_dataset_f_int2
- MODULE PROCEDURE h5ltread_dataset_f_int3
- MODULE PROCEDURE h5ltread_dataset_f_int4
- MODULE PROCEDURE h5ltread_dataset_f_int5
- MODULE PROCEDURE h5ltread_dataset_f_int6
- MODULE PROCEDURE h5ltread_dataset_f_int7
MODULE PROCEDURE h5ltread_dataset_f_ptr
END INTERFACE
- INTERFACE h5ltmake_dataset_int_f
- MODULE PROCEDURE h5ltmake_dataset_int_f_1
- MODULE PROCEDURE h5ltmake_dataset_int_f_2
- MODULE PROCEDURE h5ltmake_dataset_int_f_3
- MODULE PROCEDURE h5ltmake_dataset_int_f_4
- MODULE PROCEDURE h5ltmake_dataset_int_f_5
- MODULE PROCEDURE h5ltmake_dataset_int_f_6
- MODULE PROCEDURE h5ltmake_dataset_int_f_7
- END INTERFACE
-
- INTERFACE h5ltread_dataset_int_f
- MODULE PROCEDURE h5ltread_dataset_int_f_1
- MODULE PROCEDURE h5ltread_dataset_int_f_2
- MODULE PROCEDURE h5ltread_dataset_int_f_3
- MODULE PROCEDURE h5ltread_dataset_int_f_4
- MODULE PROCEDURE h5ltread_dataset_int_f_5
- MODULE PROCEDURE h5ltread_dataset_int_f_6
- MODULE PROCEDURE h5ltread_dataset_int_f_7
- END INTERFACE
-
INTERFACE
INTEGER FUNCTION h5ltmake_dataset_c(loc_id,namelen,dset_name,rank,dims,type_id,buf) &
BIND(C,NAME='h5ltmake_dataset_c')
diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90
index 0eb005b..0ba7815 100644
--- a/hl/fortran/test/tstlite.F90
+++ b/hl/fortran/test/tstlite.F90
@@ -19,7 +19,7 @@
#include <H5config_f.inc>
PROGRAM lite_test
-
+
CALL test_dataset1D()
CALL test_dataset2D()
CALL test_dataset3D()
@@ -38,149 +38,148 @@ END PROGRAM lite_test
!-------------------------------------------------------------------------
SUBROUTINE test_dataset1D()
+
+ USE, INTRINSIC :: ISO_C_BINDING
+ USE H5LT ! module of H5LT
+ USE HDF5 ! module of HDF5 library
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: DIM1 = 4 ! Dimension of array
+ CHARACTER(len=9), PARAMETER :: filename = "dsetf1.h5"! File name
+ CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
+ INTEGER(HID_T) :: file_id ! File identifier
+ INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions
+ INTEGER :: rank = 1 ! Dataset rank
+ INTEGER, DIMENSION(DIM1) :: buf1 ! Data buffer
+ INTEGER, DIMENSION(DIM1) :: bufr1 ! Data buffer
+ REAL, DIMENSION(DIM1) :: buf2 ! Data buffer
+ REAL, DIMENSION(DIM1) :: bufr2 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr3 ! Data buffer
+ INTEGER :: errcode ! Error flag
+ INTEGER :: i ! general purpose integer
+ TYPE(C_PTR) :: f_ptr
+ integer(HID_T) :: mytype
-USE, INTRINSIC :: ISO_C_BINDING
-USE H5LT ! module of H5LT
-USE HDF5 ! module of HDF5 library
-
-IMPLICIT NONE
-
-INTEGER, PARAMETER :: DIM1 = 4; ! Dimension of array
-CHARACTER(len=9), PARAMETER :: filename = "dsetf1.h5"! File name
-CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
-INTEGER(HID_T) :: file_id ! File identifier
-INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions
-INTEGER :: rank = 1 ! Dataset rank
-INTEGER, DIMENSION(DIM1) :: buf1 ! Data buffer
-INTEGER, DIMENSION(DIM1) :: bufr1 ! Data buffer
-REAL, DIMENSION(DIM1) :: buf2 ! Data buffer
-REAL, DIMENSION(DIM1) :: bufr2 ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr3 ! Data buffer
-INTEGER :: errcode ! Error flag
-INTEGER :: i ! general purpose integer
-TYPE(C_PTR) :: f_ptr
-integer(HID_T) :: mytype
-
-CALL test_begin(' Make/Read datasets (1D) ')
-
-!
-! Initialize the data array.
-!
-DO i = 1, DIM1
- buf1(i) = i;
- buf2(i) = i;
- buf3(i) = i;
-END DO
+ CALL test_begin(' Make/Read datasets (1D) ')
-!
-! Initialize FORTRAN predefined datatypes.
-!
-CALL h5open_f(errcode)
+ !
+ ! Initialize the data array.
+ !
+ DO i = 1, DIM1
+ buf1(i) = i
+ buf2(i) = i
+ buf3(i) = i
+ END DO
-!
-! Create a new file using default properties.
-!
-CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
+ !
+ ! Initialize FORTRAN predefined datatypes.
+ !
+ CALL h5open_f(errcode)
-!-------------------------------------------------------------------------
-! H5T_NATIVE_INTEGER
-!-------------------------------------------------------------------------
+ !
+ ! Create a new file using default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode)
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_INTEGER
+ !-------------------------------------------------------------------------
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode)
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf1, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr1, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, DIM1
- IF ( buf1(i) .NE. bufr1(i) ) THEN
- PRINT *, 'read buffer differs from write buffer (I)'
- PRINT *, bufr1(i), ' and ', buf1(i)
- STOP
- ENDIF
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1
+ IF ( buf1(i) .NE. bufr1(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer (I)'
+ PRINT *, bufr1(i), ' and ', buf1(i)
+ STOP
+ ENDIF
+ END DO
-!-------------------------------------------------------------------------
-! H5T_NATIVE_REAL
-!-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_REAL
+ !-------------------------------------------------------------------------
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode)
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_REAL, buf2, errcode)
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_REAL, bufr2, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, DIM1
- IF ( buf2(i) .NE. bufr2(i) ) THEN
- PRINT *, 'read buffer differs from write buffer (R)'
- PRINT *, bufr2(i), ' and ', buf2(i)
- STOP
- ENDIF
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1
+ IF ( buf2(i) .NE. bufr2(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer (R)'
+ PRINT *, bufr2(i), ' and ', buf2(i)
+ STOP
+ ENDIF
+ END DO
-!-------------------------------------------------------------------------
-! H5T_NATIVE_DOUBLE
-!-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_DOUBLE
+ !-------------------------------------------------------------------------
-!
-! write dataset.
-!
-f_ptr = C_LOC(buf3(1))
-mytype = h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND)
-CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, &
- mytype, f_ptr, errcode)
-!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode)
-! h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND)
-!
-! read dataset.
-!
-f_ptr = C_LOC(bufr3(1))
-CALL h5ltread_dataset_f(file_id, dsetname3, &
- h5kind_to_type(KIND(bufr3(1)), H5_REAL_KIND), f_ptr, errcode)
-!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode)
+ !
+ ! write dataset.
+ !
+ f_ptr = C_LOC(buf3(1))
+ mytype = h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND)
+ CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, &
+ mytype, f_ptr, errcode)
+ !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_DOUBLE, buf3, errcode)
+ ! h5kind_to_type(KIND(buf3(1)), H5_REAL_KIND)
+ !
+ ! read dataset.
+ !
+ f_ptr = C_LOC(bufr3(1))
+ CALL h5ltread_dataset_f(file_id, dsetname3, &
+ h5kind_to_type(KIND(bufr3(1)), H5_REAL_KIND), f_ptr, errcode)
+ !CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_DOUBLE, bufr3, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, DIM1
- IF ( buf3(i) .NE. bufr3(i) ) THEN
- PRINT *, 'read buffer differs from write buffer (D)'
- PRINT *, bufr3(i), ' and ', buf3(i)
- STOP
- ENDIF
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1
+ IF ( buf3(i) .NE. bufr3(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer (D)'
+ PRINT *, bufr3(i), ' and ', buf3(i)
+ STOP
+ ENDIF
+ END DO
-!
-! Close the file.
-!
-CALL h5fclose_f(file_id, errcode)
+ !
+ ! Close the file.
+ !
+ CALL h5fclose_f(file_id, errcode)
-!
-! Close FORTRAN predefined datatypes.
-!
-CALL h5close_f(errcode)
+ !
+ ! Close FORTRAN predefined datatypes.
+ !
+ CALL h5close_f(errcode)
-CALL passed()
-!
-! end function.
-!
+ CALL passed()
+ !
+ ! end function.
+ !
END SUBROUTINE test_dataset1D
!-------------------------------------------------------------------------
@@ -189,194 +188,193 @@ END SUBROUTINE test_dataset1D
SUBROUTINE test_dataset2D()
-USE, INTRINSIC :: ISO_C_BINDING
-USE H5LT ! module of H5LT
-USE HDF5 ! module of HDF5 library
-
-IMPLICIT NONE
-
-
-INTEGER(HSIZE_T), PARAMETER :: DIM1 = 4; ! columns
-INTEGER(HSIZE_T), PARAMETER :: DIM2 = 6; ! rows
-CHARACTER(len=9), PARAMETER :: filename = "dsetf2.h5"! File name
-CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
-INTEGER(HID_T) :: file_id ! File identifier
-INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions
-INTEGER :: rank = 2 ! Dataset rank
-INTEGER, DIMENSION(DIM1*DIM2) :: buf ! Data buffer
-INTEGER, DIMENSION(DIM1*DIM2) :: bufr ! Data buffer
-INTEGER, DIMENSION(DIM1,DIM2) :: buf2 ! Data buffer
-INTEGER, DIMENSION(DIM1,DIM2) :: buf2r ! Data buffer
-REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3 ! Data buffer
-REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3r ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4 ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4r ! Data buffer
-INTEGER :: errcode ! Error flag
-INTEGER(HSIZE_T) :: i, j, n ! general purpose integers
-TYPE(C_PTR) :: f_ptr
-
-CALL test_begin(' Make/Read datasets (2D) ')
+ USE, INTRINSIC :: ISO_C_BINDING
+ USE H5LT ! module of H5LT
+ USE HDF5 ! module of HDF5 library
+ IMPLICIT NONE
-!
-! Initialize the data arrays.
-!
-n=1
-DO i = 1, DIM1*DIM2
- buf(i) = INT(n)
- n = n + 1
-END DO
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- buf2(i,j) = INT((i-1)*dims(2) + j)
- buf3(i,j) = INT((i-1)*dims(2) + j)
- buf4(i,j) = INT((i-1)*dims(2) + j)
- END DO
-END DO
+ INTEGER(HSIZE_T), PARAMETER :: DIM1 = 4 ! columns
+ INTEGER(HSIZE_T), PARAMETER :: DIM2 = 6 ! rows
+ CHARACTER(len=9), PARAMETER :: filename = "dsetf2.h5"! File name
+ CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
+ INTEGER(HID_T) :: file_id ! File identifier
+ INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/4,6/) ! Dataset dimensions
+ INTEGER :: rank = 2 ! Dataset rank
+ INTEGER, DIMENSION(DIM1*DIM2) :: buf ! Data buffer
+ INTEGER, DIMENSION(DIM1*DIM2) :: bufr ! Data buffer
+ INTEGER, DIMENSION(DIM1,DIM2) :: buf2 ! Data buffer
+ INTEGER, DIMENSION(DIM1,DIM2) :: buf2r ! Data buffer
+ REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3 ! Data buffer
+ REAL, DIMENSION(DIM1,DIM2), TARGET :: buf3r ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1,DIM2), TARGET :: buf4r ! Data buffer
+ INTEGER :: errcode ! Error flag
+ INTEGER(HSIZE_T) :: i, j, n ! general purpose integers
+ TYPE(C_PTR) :: f_ptr
+ CALL test_begin(' Make/Read datasets (2D) ')
-!
-! Initialize FORTRAN predefined datatypes.
-!
-CALL h5open_f(errcode)
-!
-! Create a new file using default properties.
-!
-CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
+ !
+ ! Initialize the data arrays.
+ !
+ n=1
+ DO i = 1, DIM1*DIM2
+ buf(i) = INT(n)
+ n = n + 1
+ END DO
-!-------------------------------------------------------------------------
-! H5T_NATIVE_INT 1D buffer
-!-------------------------------------------------------------------------
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ buf2(i,j) = INT((i-1)*dims(2) + j)
+ buf3(i,j) = INT((i-1)*dims(2) + j)
+ buf4(i,j) = INT((i-1)*dims(2) + j)
+ END DO
+ END DO
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
+ !
+ ! Initialize FORTRAN predefined datatypes.
+ !
+ CALL h5open_f(errcode)
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
+ !
+ ! Create a new file using default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, DIM1*DIM2
- IF ( buf(i) .NE. bufr(i) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, bufr(i), ' and ', buf(i)
- STOP
- ENDIF
-END DO
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_INT 1D buffer
+ !-------------------------------------------------------------------------
-!-------------------------------------------------------------------------
-! H5T_NATIVE_INT 2D buffer
-!-------------------------------------------------------------------------
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1*DIM2
+ IF ( buf(i) .NE. bufr(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, bufr(i), ' and ', buf(i)
+ STOP
+ ENDIF
+ END DO
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- IF ( buf2(i,j) .NE. buf2r(i,j) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf2r(i,j), ' and ', buf2(i,j)
- STOP
- ENDIF
- END DO
-END DO
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_INT 2D buffer
+ !-------------------------------------------------------------------------
-!-------------------------------------------------------------------------
-! H5T_NATIVE_REAL
-!-------------------------------------------------------------------------
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
-!
-! write dataset.
-!
-f_ptr = C_LOC(buf3(1,1))
-CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode)
-!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
-!
-! read dataset.
-!
-f_ptr = C_LOC(buf3r(1,1))
-CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode)
-!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ IF ( buf2(i,j) .NE. buf2r(i,j) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf2r(i,j), ' and ', buf2(i,j)
+ STOP
+ ENDIF
+ END DO
+ END DO
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- IF ( buf3(i,j) .NE. buf3r(i,j) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf3r(i,j), ' and ', buf3(i,j)
- STOP
- ENDIF
- END DO
-END DO
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_REAL
+ !-------------------------------------------------------------------------
-!-------------------------------------------------------------------------
-! H5T_NATIVE_DOUBLE
-!-------------------------------------------------------------------------
+ !
+ ! write dataset.
+ !
+ f_ptr = C_LOC(buf3(1,1))
+ CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode)
+ !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
-!
-! write dataset.
-!
-f_ptr = C_LOC(buf4(1,1))
-CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode)
-!CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode)
+ !
+ ! read dataset.
+ !
+ f_ptr = C_LOC(buf3r(1,1))
+ CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode)
+ !CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
-!
-! read dataset.
-f_ptr = C_LOC(buf4r(1,1))
-CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode)
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ IF ( buf3(i,j) .NE. buf3r(i,j) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf3r(i,j), ' and ', buf3(i,j)
+ STOP
+ ENDIF
+ END DO
+ END DO
-!CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode)
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_DOUBLE
+ !-------------------------------------------------------------------------
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- IF ( buf4(i,j) .NE. buf4r(i,j) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf4r(i,j), ' and ', buf4(i,j)
- STOP
- ENDIF
- END DO
-END DO
+ !
+ ! write dataset.
+ !
+ f_ptr = C_LOC(buf4(1,1))
+ CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode)
+ !CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, buf4, errcode)
-!
-! Close the file.
-!
-CALL h5fclose_f(file_id, errcode)
+ !
+ ! read dataset.
+ f_ptr = C_LOC(buf4r(1,1))
+ CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode)
-!
-! Close FORTRAN predefined datatypes.
-!
-CALL h5close_f(errcode)
+ !CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode)
-CALL passed()
-!
-! end function.
-!
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ IF ( buf4(i,j) .NE. buf4r(i,j) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf4r(i,j), ' and ', buf4(i,j)
+ STOP
+ ENDIF
+ END DO
+ END DO
+
+ !
+ ! Close the file.
+ !
+ CALL h5fclose_f(file_id, errcode)
+
+ !
+ ! Close FORTRAN predefined datatypes.
+ !
+ CALL h5close_f(errcode)
+
+ CALL passed()
+ !
+ ! end function.
+ !
END SUBROUTINE test_dataset2D
@@ -386,215 +384,313 @@ END SUBROUTINE test_dataset2D
SUBROUTINE test_dataset3D()
-USE, INTRINSIC :: ISO_C_BINDING
-USE H5LT ! module of H5LT
-USE HDF5 ! module of HDF5 library
-
-IMPLICIT NONE
-
-INTEGER, PARAMETER :: DIM1 = 6 ! columns
-INTEGER, PARAMETER :: DIM2 = 4 ! rows
-INTEGER, PARAMETER :: DIM3 = 2 ! layers
-CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name
-CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
-CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
-INTEGER(HID_T) :: file_id ! File identifier
-INTEGER(HSIZE_T), DIMENSION(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions
-INTEGER(HSIZE_T), DIMENSION(3) :: dimsr ! Dataset dimensions
-INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: buf ! Data buffer
-INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: bufr ! Data buffer
-INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2 ! Data buffer
-INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2r ! Data buffer
-REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3 ! Data buffer
-REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3r ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4 ! Data buffer
-DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4r ! Data buffer
-INTEGER :: rank = 3 ! Dataset rank
-INTEGER :: errcode ! Error flag
-INTEGER(HSIZE_T) :: i, j, k, n ! general purpose integers
-INTEGER :: type_class
-INTEGER(SIZE_T) :: type_size
-TYPE(C_PTR) :: f_ptr
-CALL test_begin(' Make/Read datasets (3D) ')
+ USE, INTRINSIC :: ISO_C_BINDING
+ USE H5LT ! module of H5LT
+ USE HDF5 ! module of HDF5 library
+ IMPLICIT NONE
-!
-! Initialize the data array.
-!
-n=1
-DO i = 1, DIM1*DIM2*DIM3
- buf(i) = INT(n)
- n = n + 1
-END DO
-
-n = 1
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- DO k = 1, dims(3)
- buf2(i,j,k) = INT(n)
- buf3(i,j,k) = INT(n)
- buf4(i,j,k) = INT(n)
- n = n + 1
- END DO
- END DO
-END DO
+ INTEGER, PARAMETER :: DIM1 = 6 ! columns
+ INTEGER, PARAMETER :: DIM2 = 4 ! rows
+ INTEGER, PARAMETER :: DIM3 = 2 ! layers
+ CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File name
+ CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
+ INTEGER(HID_T) :: file_id ! File identifier
+ INTEGER(HSIZE_T), DIMENSION(3) :: dims = (/DIM1,DIM2,DIM3/) ! Dataset dimensions
+ INTEGER(HSIZE_T), DIMENSION(3) :: dimsr ! Dataset dimensions
+ INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: buf ! Data buffer
+ INTEGER, DIMENSION(DIM1*DIM2*DIM3) :: bufr ! Data buffer
+ INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2 ! Data buffer
+ INTEGER, DIMENSION(DIM1,DIM2,DIM3) :: buf2r ! Data buffer
+ REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3 ! Data buffer
+ REAL, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf3r ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1,DIM2,DIM3), TARGET :: buf4r ! Data buffer
+ INTEGER :: rank = 3 ! Dataset rank
+ INTEGER :: errcode ! Error flag
+ INTEGER(HSIZE_T) :: i, j, k, n ! general purpose integers
+ INTEGER :: type_class
+ INTEGER(SIZE_T) :: type_size
+ TYPE(C_PTR) :: f_ptr
+#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(int_kind_32), DIMENSION(DIM1,DIM2,DIM3), TARGET :: dset_data_i32, data_out_i32
+ INTEGER(HID_T) :: dset_id32 ! Dataset identifier
+ CHARACTER(LEN=7), PARAMETER :: dsetname16a = "dset16a" ! Dataset name
+ CHARACTER(LEN=7), PARAMETER :: dsetname16b = "dset16b" ! Dataset name
+ CHARACTER(LEN=7), PARAMETER :: dsetname16c = "dset16c" ! Dataset name
+ INTEGER(HID_T) :: type_id
+#endif
-!
-! Initialize FORTRAN predefined datatypes.
-!
-CALL h5open_f(errcode)
+ CALL test_begin(' Make/Read datasets (3D) ')
-!
-! Create a new file using default properties.
-!
-CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
-!-------------------------------------------------------------------------
-! H5T_NATIVE_INT 1D buffer
-!-------------------------------------------------------------------------
+ !
+ ! Initialize the data array.
+ !
+ n=1
+ DO i = 1, DIM1*DIM2*DIM3
+ buf(i) = INT(n)
+ n = n + 1
+ END DO
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
+ n = 1
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ buf2(i,j,k) = INT(n)
+ buf3(i,j,k) = INT(n)
+ buf4(i,j,k) = INT(n)
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ dset_data_i32(i,j,k) = HUGE(1_int_kind_32)-INT(n,int_kind_32)
+#endif
+ n = n + 1
+ END DO
+ END DO
+ END DO
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
+ !
+ ! Initialize FORTRAN predefined datatypes.
+ !
+ CALL h5open_f(errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, DIM1*DIM2*DIM3
- IF ( buf(i) .NE. bufr(i) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, bufr(i), ' and ', buf(i)
- STOP
- ENDIF
-END DO
+ !
+ ! Create a new file using default properties.
+ !
+ CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode)
-!-------------------------------------------------------------------------
-! H5T_NATIVE_INT 3D buffer
-!-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_INT 1D buffer
+ !-------------------------------------------------------------------------
-!
-! write dataset.
-!
-CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode)
-!
-! read dataset.
-!
-CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- DO k = 1, dims(3)
- IF ( buf2(i,j,k) .NE. buf2r(i,j,k) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf2r(i,j,k), ' and ', buf2(i,j,k)
- STOP
- ENDIF
- END DO
- END DO
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1*DIM2*DIM3
+ IF ( buf(i) .NE. bufr(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, bufr(i), ' and ', buf(i)
+ STOP
+ ENDIF
+ END DO
-!-------------------------------------------------------------------------
-! H5T_NATIVE_REAL
-!-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_INT 3D buffer
+ !-------------------------------------------------------------------------
-!
-! write dataset.
-!
-f_ptr = C_LOC(buf3(1,1,1))
-CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode)
-!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
+ !
+ ! write dataset.
+ !
+ CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, errcode)
-!
-! read dataset.
-!
-f_ptr = C_LOC(buf3r(1,1,1))
-CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode)
-!CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
+ !
+ ! read dataset.
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, buf2r, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- DO k = 1, dims(3)
- IF ( buf3(i,j,k) .NE. buf3r(i,j,k) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf3r(i,j,k), ' and ', buf3(i,j,k)
- STOP
- ENDIF
- END DO
- END DO
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( buf2(i,j,k) .NE. buf2r(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf2r(i,j,k), ' and ', buf2(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ END DO
-!-------------------------------------------------------------------------
-! H5T_NATIVE_DOUBLE
-!-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_REAL
+ !-------------------------------------------------------------------------
-!
-! write dataset.
-!
-f_ptr = C_LOC(buf4(1,1,1))
-CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode)
+ !
+ ! write dataset.
+ !
+ f_ptr = C_LOC(buf3(1,1,1))
+ CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode)
+ !CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, buf3, errcode)
-!
-! read dataset.
-!
-f_ptr = C_LOC(buf4r(1,1,1))
-CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode)
+ !
+ ! read dataset.
+ !
+ f_ptr = C_LOC(buf3r(1,1,1))
+ CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode)
+ !CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, buf3r, dims, errcode)
-!
-! compare read and write buffers.
-!
-DO i = 1, dims(1)
- DO j = 1, dims(2)
- DO k = 1, dims(3)
- IF ( buf4(i,j,k) .NE. buf4r(i,j,k) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, buf4r(i,j,k), ' and ', buf4(i,j,k)
- STOP
- ENDIF
- END DO
- END DO
-END DO
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( buf3(i,j,k) .NE. buf3r(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf3r(i,j,k), ' and ', buf3(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ END DO
-CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode )
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_DOUBLE
+ !-------------------------------------------------------------------------
-!
-! compare dimensions
-!
-DO i = 1, rank
- IF ( dimsr(i) .NE. dims(i) ) THEN
- PRINT *, 'dimensions differ '
- STOP
- ENDIF
-END DO
+ !
+ ! write dataset.
+ !
+ f_ptr = C_LOC(buf4(1,1,1))
+ CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode)
-!
-! Close the file.
-!
-CALL h5fclose_f(file_id, errcode)
+ !
+ ! read dataset.
+ !
+ f_ptr = C_LOC(buf4r(1,1,1))
+ CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode)
-!
-! Close FORTRAN predefined datatypes.
-!
-CALL h5close_f(errcode)
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( buf4(i,j,k) .NE. buf4r(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, buf4r(i,j,k), ' and ', buf4(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ END DO
-CALL passed()
-!
-! end function.
-!
+ CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode )
+
+ !
+ ! compare dimensions
+ !
+ DO i = 1, rank
+ IF ( dimsr(i) .NE. dims(i) ) THEN
+ PRINT *, 'dimensions differ '
+ STOP
+ ENDIF
+ END DO
+
+ !-------------------------------------------------------------------------
+ ! CHECKING NON-NATIVE INTEGER TYPES
+ !-------------------------------------------------------------------------
+
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+ ! (A) CHECKING INTEGER*16
+ !
+ ! (i.a) write dataset using F2003 interface
+ !
+ type_id = H5kind_to_type(KIND(dset_data_i32(1,1,1)), H5_INTEGER_KIND)
+ f_ptr = C_LOC(dset_data_i32(1,1,1))
+ CALL h5ltmake_dataset_f(file_id, dsetname16a, rank, dims, type_id, f_ptr, errcode)
+ !
+ ! (i.b) read dataset using F2003 interface
+ !
+ f_ptr = C_LOC(data_out_i32(1,1,1))
+ CALL h5ltread_dataset_f(file_id, dsetname16a, type_id, f_ptr, errcode)
+
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( dset_data_i32(i,j,k) .NE. data_out_i32(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, dset_data_i32(i,j,k), ' and ', data_out_i32(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ ENDDO
+
+ !
+ ! (ii.a) write dataset using F90 interface
+ !
+ type_id = H5kind_to_type(KIND(dset_data_i32(1,1,1)), H5_INTEGER_KIND)
+ CALL h5ltmake_dataset_f(file_id, dsetname16b, rank, dims, type_id, dset_data_i32, errcode)
+ !
+ ! (ii.b) read dataset using F90 interface
+ !
+ CALL h5ltread_dataset_f(file_id, dsetname16b, type_id, data_out_i32, dims, errcode)
+
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( dset_data_i32(i,j,k) .NE. data_out_i32(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, dset_data_i32(i,j,k), ' and ', data_out_i32(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ ENDDO
+
+ !
+ ! (iii.a) write dataset using F90 H5LTmake_dataset_int_f interface
+ !
+ CALL h5ltmake_dataset_int_f(file_id, dsetname16c, rank, dims, dset_data_i32, errcode)
+
+ !
+ ! (iii.b) read dataset using F90 H5LTmake_dataset_int_f interface
+ !
+ CALL h5ltread_dataset_int_f(file_id, dsetname16c, data_out_i32, dims, errcode)
+
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ IF ( dset_data_i32(i,j,k) .NE. data_out_i32(i,j,k) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, dset_data_i32(i,j,k), ' and ', data_out_i32(i,j,k)
+ STOP
+ ENDIF
+ END DO
+ END DO
+ ENDDO
+
+#endif
+
+ !
+ ! Close the file.
+ !
+ CALL h5fclose_f(file_id, errcode)
+
+ !
+ ! Close FORTRAN predefined datatypes.
+ !
+ CALL h5close_f(errcode)
+
+ CALL passed()
+ !
+ ! end function.
+ !
END SUBROUTINE test_dataset3D
!-------------------------------------------------------------------------
@@ -623,6 +719,7 @@ SUBROUTINE test_datasetND(rank)
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname4 = "dset4" ! Dataset name
+ CHARACTER(LEN=5), PARAMETER :: dsetname5 = "dset5" ! Dataset name
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HSIZE_T), DIMENSION(7) :: dims
INTEGER(HSIZE_T), DIMENSION(7) :: dimsr ! Dataset dimensions
@@ -650,29 +747,41 @@ SUBROUTINE test_datasetND(rank)
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbufr_6 ! Data buffer
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbuf_7 ! Data buffer
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: dbufr_7 ! Data buffer
- INTEGER :: errcode ! Error flag
- INTEGER(HSIZE_T) :: i, j, k, l, m, n, o, nn ! general purpose integers
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: cbuf_4 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: cbufr_4 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: cbuf_5 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: cbufr_5 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: cbuf_6 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: cbufr_6 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: cbuf_7 ! Data buffer
+ CHARACTER(LEN=5), ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: cbufr_7 ! Data buffer
+ INTEGER :: errcode ! Error flag
+ INTEGER(HSIZE_T) :: i, j, k, l, m, n, o, nn ! general purpose integers
INTEGER :: type_class
INTEGER(SIZE_T) :: type_size
CHARACTER(LEN=1) :: ichr1
+ CHARACTER(LEN=3) :: ichr3
TYPE(C_PTR) :: f_ptr
+ INTEGER(HID_T) :: type_id
WRITE(ichr1,'(I1.1)') rank
CALL test_begin(' Make/Read datasets ('//ichr1//'D) ')
-!
-! Initialize the data array.
-!
+ !
+ ! Initialize the data array.
+ !
IF(rank.EQ.4)THEN
-
+
ALLOCATE(ibuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4))
ALLOCATE(ibufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4))
ALLOCATE(rbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4))
ALLOCATE(rbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4))
ALLOCATE(dbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4))
ALLOCATE(dbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4))
+ ALLOCATE(cbuf_4 (1:DIM1,1:DIM2,1:DIM3,1:DIM4))
+ ALLOCATE(cbufr_4(1:DIM1,1:DIM2,1:DIM3,1:DIM4))
dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,0,0,0/)
-
+
nn = 1
DO i = 1, DIM1
DO j = 1, DIM2
@@ -681,12 +790,14 @@ SUBROUTINE test_datasetND(rank)
ibuf_4(i,j,k,l) = INT(nn)
rbuf_4(i,j,k,l) = INT(nn)
dbuf_4(i,j,k,l) = INT(nn)
+ WRITE(cbuf_4(i,j,k,l),'(I5.5)') nn
nn = nn + 1
END DO
END DO
END DO
+
ENDDO
-
+
ELSE IF(rank.EQ.5)THEN
ALLOCATE(ibuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
@@ -695,9 +806,11 @@ SUBROUTINE test_datasetND(rank)
ALLOCATE(rbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
ALLOCATE(dbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
ALLOCATE(dbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
+ ALLOCATE(cbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
+ ALLOCATE(cbufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5))
dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,0,0/)
-
+
nn = 1
DO i = 1, DIM1
DO j = 1, DIM2
@@ -707,6 +820,7 @@ SUBROUTINE test_datasetND(rank)
ibuf_5(i,j,k,l,m) = INT(nn)
rbuf_5(i,j,k,l,m) = INT(nn)
dbuf_5(i,j,k,l,m) = INT(nn)
+ WRITE(cbuf_5(i,j,k,l,m),'(I5.5)') nn
nn = nn + 1
END DO
END DO
@@ -722,9 +836,11 @@ SUBROUTINE test_datasetND(rank)
ALLOCATE(rbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6))
ALLOCATE(dbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6))
ALLOCATE(dbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6))
+ ALLOCATE(cbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6))
+ ALLOCATE(cbufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6))
dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,0/)
-
+
nn = 1
DO i = 1, DIM1
DO j = 1, DIM2
@@ -735,6 +851,7 @@ SUBROUTINE test_datasetND(rank)
ibuf_6(i,j,k,l,m,n) = INT(nn)
rbuf_6(i,j,k,l,m,n) = INT(nn)
dbuf_6(i,j,k,l,m,n) = INT(nn)
+ WRITE(cbuf_6(i,j,k,l,m,n),'(I5.5)') nn
nn = nn + 1
END DO
END DO
@@ -742,18 +859,20 @@ SUBROUTINE test_datasetND(rank)
ENDDO
ENDDO
ENDDO
-
+
ELSE IF(rank.EQ.7)THEN
-
+
ALLOCATE(ibuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
ALLOCATE(ibufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
ALLOCATE(rbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
ALLOCATE(rbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
ALLOCATE(dbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
ALLOCATE(dbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
+ ALLOCATE(cbuf_7 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
+ ALLOCATE(cbufr_7(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6,1:DIM7))
dims(1:7) = (/DIM1,DIM2,DIM3,DIM4,DIM5,DIM6,DIM7/)
-
+
nn = 1
DO i = 1, DIM1
DO j = 1, DIM2
@@ -765,6 +884,7 @@ SUBROUTINE test_datasetND(rank)
ibuf_7(i,j,k,l,m,n,o) = INT(nn)
rbuf_7(i,j,k,l,m,n,o) = INT(nn)
dbuf_7(i,j,k,l,m,n,o) = INT(nn)
+ WRITE(cbuf_7(i,j,k,l,m,n,o),'(I5.5)') nn
nn = nn + 1
END DO
END DO
@@ -803,7 +923,7 @@ SUBROUTINE test_datasetND(rank)
ELSE IF(rank.EQ.7)THEN
CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_7, errcode)
ENDIF
-
+
!
! read dataset.
@@ -874,7 +994,7 @@ SUBROUTINE test_datasetND(rank)
IF(rank.EQ.4)THEN
f_ptr = C_LOC(rbuf_4(1,1,1,1))
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode)
- ! CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_4, errcode)
+ ! CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_4, errcode)
ELSE IF(rank.EQ.5)THEN
f_ptr = C_LOC(rbuf_5(1,1,1,1,1))
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode)
@@ -887,7 +1007,7 @@ SUBROUTINE test_datasetND(rank)
CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, f_ptr, errcode)
!CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims(1:rank), H5T_NATIVE_REAL, rbuf_7, errcode)
ENDIF
-
+
!
! read dataset.
@@ -972,7 +1092,6 @@ SUBROUTINE test_datasetND(rank)
f_ptr = C_LOC(dbuf_7(1,1,1,1,1,1,1))
CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode)
ENDIF
-
!
! read dataset.
@@ -1037,8 +1156,97 @@ SUBROUTINE test_datasetND(rank)
ENDDO
ENDDO
+ !-------------------------------------------------------------------------
+ ! H5T_NATIVE_CHARACTER ND buffer
+ !-------------------------------------------------------------------------
+
+ CALL H5Tcopy_f(H5T_FORTRAN_S1, type_id, errcode)
+ CALL H5Tset_size_f(type_id, 5_SIZE_T, errcode)
+ !
+ ! write dataset.
+ !
+ IF(rank.EQ.4)THEN
+ f_ptr = C_LOC(cbuf_4(1,1,1,1)(1:1))
+ CALL h5ltmake_dataset_f(file_id, dsetname5, rank, dims(1:rank), type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.5)THEN
+ f_ptr = C_LOC(cbuf_5(1,1,1,1,1)(1:1))
+ CALL h5ltmake_dataset_f(file_id, dsetname5, rank, dims(1:rank), type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.6)THEN
+ f_ptr = C_LOC(cbuf_6(1,1,1,1,1,1)(1:1))
+ CALL h5ltmake_dataset_f(file_id, dsetname5, rank, dims(1:rank), type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.7)THEN
+ f_ptr = C_LOC(cbuf_7(1,1,1,1,1,1,1)(1:1))
+ CALL h5ltmake_dataset_f(file_id, dsetname5, rank, dims(1:rank), type_id, f_ptr, errcode)
+ ENDIF
+
+ !
+ ! read dataset.
+ !
+ IF(rank.EQ.4)THEN
+ f_ptr = C_LOC(cbufr_4(1,1,1,1)(1:1))
+ CALL h5ltread_dataset_f(file_id, dsetname5, type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.5)THEN
+ f_ptr = C_LOC(cbufr_5(1,1,1,1,1)(1:1))
+ CALL h5ltread_dataset_f(file_id, dsetname5, type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.6)THEN
+ f_ptr = C_LOC(cbufr_6(1,1,1,1,1,1)(1:1))
+ CALL h5ltread_dataset_f(file_id, dsetname5, type_id, f_ptr, errcode)
+ ELSE IF(rank.EQ.7)THEN
+ f_ptr = C_LOC(cbufr_7(1,1,1,1,1,1,1)(1:1))
+ CALL h5ltread_dataset_f(file_id, dsetname5, type_id, f_ptr, errcode)
+ ENDIF
+
+
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, dims(1)
+ DO j = 1, dims(2)
+ DO k = 1, dims(3)
+ DO l = 1, dims(4)
+ IF(rank.EQ.4)THEN
+ IF ( cbuf_4(i,j,k,l) .NE. cbufr_4(i,j,k,l) ) THEN
+ PRINT *, 'read buffer differs from write buffer (character)'
+ PRINT *, cbuf_4(i,j,k,l), ' and ', cbufr_4(i,j,k,l)
+ STOP
+ ENDIF
+ ENDIF
+ DO m = 1, dims(5)
+ IF(rank.EQ.5)THEN
+ IF ( cbuf_5(i,j,k,l,m) .NE. cbufr_5(i,j,k,l,m) ) THEN
+ PRINT *, 'read buffer differs from write buffer (character)'
+ PRINT *, cbuf_5(i,j,k,l,m), ' and ', cbufr_5(i,j,k,l,m)
+ STOP
+ ENDIF
+ ENDIF
+ DO n = 1, dims(6)
+ IF(rank.EQ.6)THEN
+ IF ( cbuf_6(i,j,k,l,m,n) .NE. cbufr_6(i,j,k,l,m,n) ) THEN
+ PRINT *, 'read buffer differs from write buffer (character)'
+ PRINT *, cbuf_6(i,j,k,l,m,n), ' and ', cbufr_6(i,j,k,l,m,n)
+ STOP
+ ENDIF
+ ENDIF
+ DO o = 1, dims(7)
+ IF(rank.EQ.7)THEN
+ IF ( cbuf_7(i,j,k,l,m,n,o) .NE. cbufr_7(i,j,k,l,m,n,o) ) THEN
+ PRINT *, 'read buffer differs from write buffer (character)'
+ PRINT *, cbuf_7(i,j,k,l,m,n,o), ' and ', cbufr_7(i,j,k,l,m,n,o)
+ STOP
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode )
+ CALL h5tclose_f(type_id,errcode)
+
!
! compare dimensions
!
@@ -1062,13 +1270,13 @@ SUBROUTINE test_datasetND(rank)
! DEALLOCATE RESOURCES
IF(rank.EQ.4)THEN
- DEALLOCATE(ibuf_4, ibufr_4, rbuf_4, rbufr_4, dbuf_4, dbufr_4)
+ DEALLOCATE(ibuf_4, ibufr_4, rbuf_4, rbufr_4, dbuf_4, dbufr_4, cbuf_4, cbufr_4)
ELSE IF(rank.EQ.5)THEN
- DEALLOCATE(ibuf_5, ibufr_5, rbuf_5, rbufr_5, dbuf_5, dbufr_5)
+ DEALLOCATE(ibuf_5, ibufr_5, rbuf_5, rbufr_5, dbuf_5, dbufr_5, cbuf_5, cbufr_5)
ELSE IF(rank.EQ.6)THEN
- DEALLOCATE(ibuf_6, ibufr_6, rbuf_6, rbufr_6, dbuf_6, dbufr_6)
+ DEALLOCATE(ibuf_6, ibufr_6, rbuf_6, rbufr_6, dbuf_6, dbufr_6, cbuf_6, cbufr_6)
ELSE IF(rank.EQ.7)THEN
- DEALLOCATE(ibuf_7, ibufr_7, rbuf_7, rbufr_7, dbuf_7, dbufr_7)
+ DEALLOCATE(ibuf_7, ibufr_7, rbuf_7, rbufr_7, dbuf_7, dbufr_7, cbuf_7, cbufr_7)
ENDIF
CALL passed()
@@ -1078,7 +1286,6 @@ SUBROUTINE test_datasetND(rank)
END SUBROUTINE test_datasetND
-
!-------------------------------------------------------------------------
! test_datasets
!-------------------------------------------------------------------------
@@ -1094,7 +1301,7 @@ SUBROUTINE test_datasets()
CHARACTER(len=9), PARAMETER :: filename = "dsetf4.h5"! File name
INTEGER(HID_T) :: file_id ! File identifier
INTEGER :: errcode ! Error flag
- INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
+ INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname2 = "dset2" ! Dataset name
CHARACTER(LEN=5), PARAMETER :: dsetname3 = "dset3" ! Dataset name
@@ -1108,10 +1315,10 @@ SUBROUTINE test_datasets()
CHARACTER(LEN=8) :: buf1r ! Data buffer
INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer
INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer
- REAL, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer
- REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer
- DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer
- DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer
+ REAL, DIMENSION(DIM1), TARGET :: buf3 ! Data buffer
+ REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer
+ DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer
INTEGER :: i, n ! general purpose integer
INTEGER :: has ! general purpose integer
INTEGER :: type_class
@@ -1289,7 +1496,7 @@ SUBROUTINE test_datasets()
IF(errcode.LT.0.OR..NOT.path_valid)THEN
PRINT *, 'error in h5ltpath_valid_f'
STOP
- ENDIF
+ ENDIF
! Should fail, dataset does not exist
CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode)
@@ -1306,14 +1513,14 @@ SUBROUTINE test_datasets()
! Create a dangling soft link
CALL h5lcreate_soft_f("/G2", file_id, "/G3", errcode)
-
+
! Should pass, does not check for dangled link
CALL h5ltpath_valid_f(file_id, "/G3", .FALSE., path_valid, errcode)
IF(.NOT.path_valid)THEN
PRINT *, 'error in h5ltpath_valid_f'
STOP
ENDIF
-
+
! Should fail, dangled link
CALL h5ltpath_valid_f(file_id, "/G2", .TRUE., path_valid, errcode)
IF(path_valid)THEN
@@ -1336,7 +1543,6 @@ SUBROUTINE test_datasets()
STOP
ENDIF
-
!-------------------------------------------------------------------------
! test h5ltfind_dataset_f function
!-------------------------------------------------------------------------
@@ -1352,7 +1558,6 @@ SUBROUTINE test_datasets()
! test h5ltget_dataset_info_f function
!-------------------------------------------------------------------------
-
CALL h5ltget_dataset_info_f(file_id,dsetname4,dimsr,type_class,type_size,errcode )
!
@@ -1402,7 +1607,7 @@ SUBROUTINE test_attributes()
CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name
CHARACTER(len=9), PARAMETER :: filename1 ="tattr.h5" ! C written attribute file
INTEGER(HID_T) :: file_id ! File identifier
-! INTEGER(HID_T) :: file_id1
+ ! INTEGER(HID_T) :: file_id1
INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array
CHARACTER(LEN=5), PARAMETER :: attrname1 = "attr1" ! Attribute name
CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name
@@ -1413,8 +1618,8 @@ SUBROUTINE test_attributes()
CHARACTER(LEN=16), PARAMETER :: buf_c = "string attribute"
CHARACTER(LEN=8) :: bufr1 ! Data buffer
CHARACTER(LEN=10) :: bufr1_lg ! Data buffer
-! CHARACTER(LEN=16) :: bufr_c ! Data buffer
-! CHARACTER(LEN=18) :: bufr_c_lg ! Data buffer
+ ! CHARACTER(LEN=16) :: bufr_c ! Data buffer
+ ! CHARACTER(LEN=18) :: bufr_c_lg ! Data buffer
INTEGER, DIMENSION(DIM1) :: buf2 ! Data buffer
INTEGER, DIMENSION(DIM1) :: bufr2 ! Data buffer
REAL, DIMENSION(DIM1), target :: buf3 ! Data buffer
@@ -1547,41 +1752,41 @@ SUBROUTINE test_attributes()
IF(SizeOf_buf_type.LT.16)THEN ! MSB can't handle 16 byte reals
- CALL test_begin(' Set/Get attributes double ')
+ CALL test_begin(' Set/Get attributes double ')
- !
- ! write attribute.
- !
- f_ptr = C_LOC(buf4(1))
- CALL h5ltset_attribute_f(file_id,dsetname1,attrname4,f_ptr,"real", SizeOf_buf_type, size, errcode)
+ !
+ ! write attribute.
+ !
+ f_ptr = C_LOC(buf4(1))
+ CALL h5ltset_attribute_f(file_id,dsetname1,attrname4,f_ptr,"real", SizeOf_buf_type, size, errcode)
-! CALL h5ltset_attribute_double_f(file_id,dsetname1,attrname4,buf4, size, errcode)
+ ! CALL h5ltset_attribute_double_f(file_id,dsetname1,attrname4,buf4, size, errcode)
- !
- ! read attribute.
- !
+ !
+ ! read attribute.
+ !
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
- SizeOf_buf_type = STORAGE_SIZE(bufr4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
+ SizeOf_buf_type = STORAGE_SIZE(bufr4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
#else
- SizeOf_buf_type = SIZEOF(bufr4(1))
+ SizeOf_buf_type = SIZEOF(bufr4(1))
#endif
- f_ptr = C_LOC(bufr4(1))
- CALL h5ltget_attribute_f(file_id,dsetname1,attrname4,f_ptr,"REAL",SizeOf_buf_type,errcode)
+ f_ptr = C_LOC(bufr4(1))
+ CALL h5ltget_attribute_f(file_id,dsetname1,attrname4,f_ptr,"REAL",SizeOf_buf_type,errcode)
- !
- ! compare read and write buffers.
- !
- DO i = 1, DIM1
- IF ( buf4(i) .NE. bufr4(i) ) THEN
- PRINT *, 'read buffer differs from write buffer'
- PRINT *, bufr4(i), ' and ', buf4(i)
- STOP
- ENDIF
- END DO
-
- CALL passed()
+ !
+ ! compare read and write buffers.
+ !
+ DO i = 1, DIM1
+ IF ( buf4(i) .NE. bufr4(i) ) THEN
+ PRINT *, 'read buffer differs from write buffer'
+ PRINT *, bufr4(i), ' and ', buf4(i)
+ STOP
+ ENDIF
+ END DO
+
+ CALL passed()
ENDIF