From 8ca794438092595180b66bf06087e942e0a40bb7 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 29 Jun 2016 14:21:19 -0500 Subject: [svn-r30120] Fixed compilation failure on emu due to moving testing subroutines into a module. Tested: emu and jelly (gnu) --- hl/fortran/test/tstlite.F90 | 3665 +++++++++++++++++++++---------------------- 1 file changed, 1822 insertions(+), 1843 deletions(-) diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90 index 9d47c59..42e2bcc 100644 --- a/hl/fortran/test/tstlite.F90 +++ b/hl/fortran/test/tstlite.F90 @@ -20,1900 +20,1880 @@ MODULE TSTLITE -CONTAINS - -!------------------------------------------------------------------------- -! test_begin -!------------------------------------------------------------------------- - -SUBROUTINE test_begin(string) - CHARACTER(LEN=*), INTENT(IN) :: string - WRITE(*, fmt = '(14a)', advance = 'no') string - WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' -END SUBROUTINE test_begin - -!------------------------------------------------------------------------- -! passed -!------------------------------------------------------------------------- - -SUBROUTINE passed() - WRITE(*, fmt = '(6a)') 'PASSED' -END SUBROUTINE passed - -END MODULE TSTLITE - -MODULE TSTLITE_TESTS + IMPLICIT NONE CONTAINS - -!------------------------------------------------------------------------- -! test_dataset1D -!------------------------------------------------------------------------- - -SUBROUTINE test_dataset1D() - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - USE TSTLITE ! module for testing lite support routines - - 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 - - ! - ! 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) - !------------------------------------------------------------------------- - ! H5T_NATIVE_INTEGER + ! test_begin !------------------------------------------------------------------------- - ! - ! 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 + SUBROUTINE test_begin(string) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(14a)', advance = 'no') string + WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' + END SUBROUTINE test_begin !------------------------------------------------------------------------- - ! H5T_NATIVE_REAL + ! passed !------------------------------------------------------------------------- - ! - ! 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) - - ! - ! 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 + SUBROUTINE passed() + IMPLICIT NONE + WRITE(*, fmt = '(6a)') 'PASSED' + END SUBROUTINE passed - !------------------------------------------------------------------------- - ! H5T_NATIVE_DOUBLE - !------------------------------------------------------------------------- +END MODULE TSTLITE - ! - ! 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 - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_dataset1D - -!------------------------------------------------------------------------- -! test_dataset2D -!------------------------------------------------------------------------- - -SUBROUTINE test_dataset2D() +MODULE TSTLITE_TESTS USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library + USE H5LT ! module of H5LT + USE HDF5 ! module of HDF5 library USE TSTLITE ! module for testing lite support routines - IMPLICIT NONE +CONTAINS - 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 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 - - ! - ! 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) !------------------------------------------------------------------------- - ! H5T_NATIVE_INT 1D buffer + ! test_dataset1D !------------------------------------------------------------------------- - ! - ! write dataset. - ! - CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) - - ! - ! read dataset. - ! - CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, 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 + SUBROUTINE test_dataset1D() + + 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 + + ! + ! 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) + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INTEGER + !------------------------------------------------------------------------- + + ! + ! 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 + + !------------------------------------------------------------------------- + ! H5T_NATIVE_REAL + !------------------------------------------------------------------------- + + ! + ! 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) + + ! + ! 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 + !------------------------------------------------------------------------- + + ! + ! 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 + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + CALL passed() + ! + ! end function. + ! + END SUBROUTINE test_dataset1D !------------------------------------------------------------------------- - ! H5T_NATIVE_INT 2D buffer + ! test_dataset2D !------------------------------------------------------------------------- - ! - ! write dataset. - ! - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, 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) - 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_REAL - !------------------------------------------------------------------------- + SUBROUTINE test_dataset2D() + + 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) ') + + + ! + ! 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 + + ! + ! 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) + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT 1D buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, 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 + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT 2D buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, 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) + 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_REAL + !------------------------------------------------------------------------- + + ! + ! 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. + ! + 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 ( 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_DOUBLE + !------------------------------------------------------------------------- + + ! + ! 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(buf4r(1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + + !CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) + + ! + ! 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 - ! - ! 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. - ! - 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 ( 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_DOUBLE + ! test_dataset3D !------------------------------------------------------------------------- - ! - ! 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(buf4r(1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - - !CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, buf4r, dims, errcode) - - ! - ! 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 - - -!------------------------------------------------------------------------- -! test_dataset3D -!------------------------------------------------------------------------- - - -SUBROUTINE test_dataset3D() - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - USE TSTLITE ! module for testing lite support routines - 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 + SUBROUTINE test_dataset3D() + + 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 #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 - 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 + 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 + 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 - CALL test_begin(' Make/Read datasets (3D) ') - - - ! - ! 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) + CALL test_begin(' Make/Read datasets (3D) ') + + + ! + ! 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) #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 - dset_data_i32(i,j,k) = HUGE(1_int_kind_32)-INT(n,int_kind_32) + 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 - - ! - ! 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) - - !------------------------------------------------------------------------- - ! H5T_NATIVE_INT 1D buffer - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) - - ! - ! read dataset. - ! - CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, 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 - - !------------------------------------------------------------------------- - ! H5T_NATIVE_INT 3D buffer - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, 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 ( 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_REAL - !------------------------------------------------------------------------- - - ! - ! 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(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 ( 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 - - !------------------------------------------------------------------------- - ! H5T_NATIVE_DOUBLE - !------------------------------------------------------------------------- - - ! - ! 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) - - ! - ! read dataset. - ! - f_ptr = C_LOC(buf4r(1,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) - 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 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 - !------------------------------------------------------------------------- + n = n + 1 + END DO + END DO + END DO + + ! + ! 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) + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT 1D buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_f(file_id, dsetname1, rank, dims, H5T_NATIVE_INTEGER, buf, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_f(file_id, dsetname1, H5T_NATIVE_INTEGER, bufr, dims, 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 + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT 3D buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims, H5T_NATIVE_INTEGER, buf2, 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 ( 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_REAL + !------------------------------------------------------------------------- + + ! + ! 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(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 ( 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 + + !------------------------------------------------------------------------- + ! H5T_NATIVE_DOUBLE + !------------------------------------------------------------------------- + + ! + ! 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) + + ! + ! read dataset. + ! + f_ptr = C_LOC(buf4r(1,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) + 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 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 + ! (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 - -!------------------------------------------------------------------------- -! test_datasetND -!------------------------------------------------------------------------- - - -SUBROUTINE test_datasetND(rank) - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - USE TSTLITE ! module for testing lite support routines - - IMPLICIT NONE - - INTEGER :: rank ! Dataset rank - - INTEGER, PARAMETER :: DIM1 = 2 ! columns - INTEGER, PARAMETER :: DIM2 = 4 ! rows - INTEGER, PARAMETER :: DIM3 = 2 ! layers - INTEGER, PARAMETER :: DIM4 = 5 ! columns - INTEGER, PARAMETER :: DIM5 = 4 ! rows - INTEGER, PARAMETER :: DIM6 = 3 ! layers - INTEGER, PARAMETER :: DIM7 = 2 ! layers - CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File 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 - 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 - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibuf_4 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibufr_4 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibuf_5 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibufr_5 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibuf_6 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibufr_6 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibuf_7 ! Data buffer - INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibufr_7 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbuf_4 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbufr_4 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbuf_5 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbufr_5 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbuf_6 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbufr_6 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbuf_7 ! Data buffer - REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbufr_7 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbuf_4 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbufr_4 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbuf_5 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbufr_5 ! Data buffer - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbuf_6 ! Data buffer - 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 - 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 - 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. - ! - 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 - DO k = 1, DIM3 - DO l = 1, DIM4 - 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)) - ALLOCATE(ibufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - ALLOCATE(rbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) - 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 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - 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 - END DO - ENDDO - ENDDO - - ELSE IF(rank.EQ.6)THEN - - ALLOCATE(ibuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(ibufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - ALLOCATE(rbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) - 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 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - DO n = 1, DIM6 - 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 - END DO - 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 - DO k = 1, DIM3 - DO l = 1, DIM4 - DO m = 1, DIM5 - DO n = 1, DIM6 - DO o = 1, DIM7 - 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 - END DO - ENDDO - ENDDO - ENDDO - ENDDO - - ENDIF - - ! - ! 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) - - !------------------------------------------------------------------------- - ! H5T_NATIVE_INT ND buffer - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - IF(rank.EQ.4)THEN - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_4, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(ibuf_5(1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_6, errcode) - 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. - ! - IF(rank.EQ.4)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_4, dims(1:rank), errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(ibufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_6, dims(1:rank), errcode) - ELSE IF(rank.EQ.7)THEN - CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_7, dims(1:rank), 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 ( ibuf_4(i,j,k,l) .NE. ibufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_4(i,j,k,l), ' and ', ibufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( ibuf_5(i,j,k,l,m) .NE. ibufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_5(i,j,k,l,m), ' and ', ibufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( ibuf_6(i,j,k,l,m,n) .NE. ibufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_6(i,j,k,l,m,n), ' and ', ibufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( ibuf_7(i,j,k,l,m,n,o) .NE. ibufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, ibuf_7(i,j,k,l,m,n,o), ' and ', ibufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - !------------------------------------------------------------------------- - ! H5T_NATIVE_REAL - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - 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) - 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) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(rbuf_6(1,1,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_6, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(rbuf_7(1,1,1,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_7, errcode) - ENDIF - - - ! - ! read dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(rbufr_4(1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(rbufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(rbufr_6(1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(rbufr_7(1,1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, 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 ( rbuf_4(i,j,k,l) .NE. rbufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_4(i,j,k,l), ' and ', rbufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( rbuf_5(i,j,k,l,m) .NE. rbufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_5(i,j,k,l,m), ' and ', rbufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( rbuf_6(i,j,k,l,m,n) .NE. rbufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_6(i,j,k,l,m,n), ' and ', rbufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( rbuf_7(i,j,k,l,m,n,o) .NE. rbufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, rbuf_7(i,j,k,l,m,n,o), ' and ', rbufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - - !------------------------------------------------------------------------- - ! H5T_NATIVE_DOUBLE - !------------------------------------------------------------------------- - - ! - ! write dataset. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(dbuf_4(1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(dbuf_5(1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(dbuf_6(1,1,1,1,1,1)) - CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - 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. - ! - IF(rank.EQ.4)THEN - f_ptr = C_LOC(dbufr_4(1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.5)THEN - f_ptr = C_LOC(dbufr_5(1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.6)THEN - f_ptr = C_LOC(dbufr_6(1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - ELSE IF(rank.EQ.7)THEN - f_ptr = C_LOC(dbufr_7(1,1,1,1,1,1,1)) - CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, 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 ( dbuf_4(i,j,k,l) .NE. dbufr_4(i,j,k,l) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_4(i,j,k,l), ' and ', dbufr_4(i,j,k,l) - STOP - ENDIF - ENDIF - DO m = 1, dims(5) - IF(rank.EQ.5)THEN - IF ( dbuf_5(i,j,k,l,m) .NE. dbufr_5(i,j,k,l,m) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_5(i,j,k,l,m), ' and ', dbufr_5(i,j,k,l,m) - STOP - ENDIF - ENDIF - DO n = 1, dims(6) - IF(rank.EQ.6)THEN - IF ( dbuf_6(i,j,k,l,m,n) .NE. dbufr_6(i,j,k,l,m,n) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_6(i,j,k,l,m,n), ' and ', dbufr_6(i,j,k,l,m,n) - STOP - ENDIF - ENDIF - DO o = 1, dims(7) - IF(rank.EQ.7)THEN - IF ( dbuf_7(i,j,k,l,m,n,o) .NE. dbufr_7(i,j,k,l,m,n,o) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, dbuf_7(i,j,k,l,m,n,o), ' and ', dbufr_7(i,j,k,l,m,n,o) - STOP - ENDIF - ENDIF - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - 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 - ! - DO i = 1, rank - IF ( dimsr(i) .NE. dims(i) ) THEN - PRINT *, 'dimensions differ ' - STOP - ENDIF - END DO - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - ! DEALLOCATE RESOURCES - - IF(rank.EQ.4)THEN - 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, cbuf_5, cbufr_5) - ELSE IF(rank.EQ.6)THEN - 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, cbuf_7, cbufr_7) - ENDIF - - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_datasetND - - -!------------------------------------------------------------------------- -! test_datasets -!------------------------------------------------------------------------- - -SUBROUTINE test_datasets() - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - USE TSTLITE ! module for testing lite support routines - - IMPLICIT NONE - - 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 :: LEN0 = 3 - INTEGER, PARAMETER :: LEN1 = 12 - 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 - CHARACTER(LEN=5), PARAMETER :: dsetname6 = "dset6" ! Dataset name - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! Dataset dimensions - INTEGER :: rank = 1 ! Dataset rank - INTEGER :: rankr ! Dataset rank - CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer - 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 - INTEGER :: i, j, n ! general purpose integer - INTEGER :: has ! general purpose integer - INTEGER :: type_class - INTEGER(SIZE_T) :: type_size - LOGICAL :: path_valid ! status of the path - CHARACTER(LEN=6) :: chr_exact - CHARACTER(LEN=8) :: chr_lg - TYPE(C_PTR) :: f_ptr - - ! vl data - TYPE vl - INTEGER, DIMENSION(:), POINTER :: DATA - END TYPE vl - TYPE(vl), DIMENSION(:), ALLOCATABLE, TARGET :: ptr - TYPE(hvl_t), DIMENSION(1:2), TARGET :: wdata ! Array of vlen structures - TYPE(hvl_t), DIMENSION(1:2), TARGET :: rdata ! Pointer to vlen structures - INTEGER(hsize_t), DIMENSION(1:1) :: dims_vl = (/2/) - INTEGER, DIMENSION(:), POINTER :: ptr_r - INTEGER(HID_T) :: type_id - - ! - ! 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 array. - ! - n = 1 - DO i = 1, DIM1 - buf2(i) = n - buf3(i) = n - buf4(i) = n - n = n + 1 - END DO - - ! - ! Initialize variable-length data. wdata(1) is a countdown of - ! length LEN0, wdata(2) is a Fibonacci sequence of length LEN1. - ! - wdata(1)%len = LEN0 - wdata(2)%len = LEN1 - - ALLOCATE( ptr(1:2) ) - ALLOCATE( ptr(1)%data(1:wdata(1)%len) ) - ALLOCATE( ptr(2)%data(1:wdata(2)%len) ) - - DO i=1, wdata(1)%len - ptr(1)%data(i) = wdata(1)%len - i + 1 ! 3 2 1 - ENDDO - wdata(1)%p = C_LOC(ptr(1)%data(1)) - - ptr(2)%data(1:2) = 1 - DO i = 3, wdata(2)%len - ptr(2)%data(i) = ptr(2)%data(i-1) + ptr(2)%data(i-2) ! (1 1 2 3 5 8 etc.) - ENDDO - wdata(2)%p = C_LOC(ptr(2)%data(1)) - - !------------------------------------------------------------------------- - ! int - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (integer) ') - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode) - - ! - ! read dataset. - ! - CALL h5ltread_dataset_int_f(file_id, dsetname2, 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' - PRINT *, bufr2(i), ' and ', buf2(i) - STOP - ENDIF - END DO - - CALL passed() - - - !------------------------------------------------------------------------- - ! real - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (float) ') - - - ! - ! write dataset. - ! - f_ptr = C_LOC(buf3(1)) - CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) - - ! - ! read dataset. - ! - f_ptr = C_LOC(bufr3(1)) - CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf3(i) .NE. bufr3(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr3(i), ' and ', buf3(i) - STOP - ENDIF - END DO - - CALL passed() + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) - !------------------------------------------------------------------------- - ! double - !------------------------------------------------------------------------- - - CALL test_begin(' Make/Read datasets (double) ') - - - ! - ! write dataset. - ! - !f_ptr = C_LOC(buf4(1)) - !CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) - CALL h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode) - - ! - ! read dataset. - ! - !f_ptr = C_LOC(buf4(1)) - !CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) - CALL h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, 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() + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + CALL passed() + ! + ! end function. + ! + END SUBROUTINE test_dataset3D !------------------------------------------------------------------------- - ! string + ! test_datasetND !------------------------------------------------------------------------- - CALL test_begin(' Make/Read datasets (string) ') - - - ! - ! write dataset. - ! - CALL h5ltmake_dataset_string_f(file_id, dsetname5, buf1, errcode) - ! - ! read dataset. - ! - CALL h5ltread_dataset_string_f(file_id, dsetname5, buf1r, errcode) + SUBROUTINE test_datasetND(rank) + + IMPLICIT NONE + + INTEGER :: rank ! Dataset rank + + INTEGER, PARAMETER :: DIM1 = 2 ! columns + INTEGER, PARAMETER :: DIM2 = 4 ! rows + INTEGER, PARAMETER :: DIM3 = 2 ! layers + INTEGER, PARAMETER :: DIM4 = 5 ! columns + INTEGER, PARAMETER :: DIM5 = 4 ! rows + INTEGER, PARAMETER :: DIM6 = 3 ! layers + INTEGER, PARAMETER :: DIM7 = 2 ! layers + CHARACTER(len=9), PARAMETER :: filename = "dsetf3.h5" ! File 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 + 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 + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibuf_4 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: ibufr_4 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibuf_5 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: ibufr_5 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibuf_6 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:) :: ibufr_6 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibuf_7 ! Data buffer + INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:) :: ibufr_7 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbuf_4 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: rbufr_4 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbuf_5 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: rbufr_5 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbuf_6 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: rbufr_6 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbuf_7 ! Data buffer + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:,:,:), TARGET :: rbufr_7 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbuf_4 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:), TARGET :: dbufr_4 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbuf_5 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:), TARGET :: dbufr_5 ! Data buffer + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:,:,:), TARGET :: dbuf_6 ! Data buffer + 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 + 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 + 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. + ! + 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 + DO k = 1, DIM3 + DO l = 1, DIM4 + 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)) + ALLOCATE(ibufr_5(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + ALLOCATE(rbuf_5 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5)) + 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 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + 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 + END DO + ENDDO + ENDDO + + ELSE IF(rank.EQ.6)THEN + + ALLOCATE(ibuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(ibufr_6(1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + ALLOCATE(rbuf_6 (1:DIM1,1:DIM2,1:DIM3,1:DIM4,1:DIM5,1:DIM6)) + 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 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + DO n = 1, DIM6 + 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 + END DO + 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 + DO k = 1, DIM3 + DO l = 1, DIM4 + DO m = 1, DIM5 + DO n = 1, DIM6 + DO o = 1, DIM7 + 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 + END DO + ENDDO + ENDDO + ENDDO + ENDDO + + ENDIF + + ! + ! 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) + + !------------------------------------------------------------------------- + ! H5T_NATIVE_INT ND buffer + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + IF(rank.EQ.4)THEN + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_4, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(ibuf_5(1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + CALL h5ltmake_dataset_f(file_id, dsetname2, rank, dims(1:rank), H5T_NATIVE_INTEGER, ibuf_6, errcode) + 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. + ! + IF(rank.EQ.4)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_4, dims(1:rank), errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(ibufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_6, dims(1:rank), errcode) + ELSE IF(rank.EQ.7)THEN + CALL h5ltread_dataset_f(file_id, dsetname2, H5T_NATIVE_INTEGER, ibufr_7, dims(1:rank), 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 ( ibuf_4(i,j,k,l) .NE. ibufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_4(i,j,k,l), ' and ', ibufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( ibuf_5(i,j,k,l,m) .NE. ibufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_5(i,j,k,l,m), ' and ', ibufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( ibuf_6(i,j,k,l,m,n) .NE. ibufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_6(i,j,k,l,m,n), ' and ', ibufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( ibuf_7(i,j,k,l,m,n,o) .NE. ibufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, ibuf_7(i,j,k,l,m,n,o), ' and ', ibufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + !------------------------------------------------------------------------- + ! H5T_NATIVE_REAL + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + 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) + 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) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(rbuf_6(1,1,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_6, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(rbuf_7(1,1,1,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_7, errcode) + ENDIF + + + ! + ! read dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(rbufr_4(1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(rbufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(rbufr_6(1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(rbufr_7(1,1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, 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 ( rbuf_4(i,j,k,l) .NE. rbufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_4(i,j,k,l), ' and ', rbufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( rbuf_5(i,j,k,l,m) .NE. rbufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_5(i,j,k,l,m), ' and ', rbufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( rbuf_6(i,j,k,l,m,n) .NE. rbufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_6(i,j,k,l,m,n), ' and ', rbufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( rbuf_7(i,j,k,l,m,n,o) .NE. rbufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, rbuf_7(i,j,k,l,m,n,o), ' and ', rbufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + + !------------------------------------------------------------------------- + ! H5T_NATIVE_DOUBLE + !------------------------------------------------------------------------- + + ! + ! write dataset. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(dbuf_4(1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(dbuf_5(1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(dbuf_6(1,1,1,1,1,1)) + CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims(1:rank), H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + 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. + ! + IF(rank.EQ.4)THEN + f_ptr = C_LOC(dbufr_4(1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.5)THEN + f_ptr = C_LOC(dbufr_5(1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.6)THEN + f_ptr = C_LOC(dbufr_6(1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + ELSE IF(rank.EQ.7)THEN + f_ptr = C_LOC(dbufr_7(1,1,1,1,1,1,1)) + CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, 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 ( dbuf_4(i,j,k,l) .NE. dbufr_4(i,j,k,l) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_4(i,j,k,l), ' and ', dbufr_4(i,j,k,l) + STOP + ENDIF + ENDIF + DO m = 1, dims(5) + IF(rank.EQ.5)THEN + IF ( dbuf_5(i,j,k,l,m) .NE. dbufr_5(i,j,k,l,m) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_5(i,j,k,l,m), ' and ', dbufr_5(i,j,k,l,m) + STOP + ENDIF + ENDIF + DO n = 1, dims(6) + IF(rank.EQ.6)THEN + IF ( dbuf_6(i,j,k,l,m,n) .NE. dbufr_6(i,j,k,l,m,n) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_6(i,j,k,l,m,n), ' and ', dbufr_6(i,j,k,l,m,n) + STOP + ENDIF + ENDIF + DO o = 1, dims(7) + IF(rank.EQ.7)THEN + IF ( dbuf_7(i,j,k,l,m,n,o) .NE. dbufr_7(i,j,k,l,m,n,o) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, dbuf_7(i,j,k,l,m,n,o), ' and ', dbufr_7(i,j,k,l,m,n,o) + STOP + ENDIF + ENDIF + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + 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 + ! + DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF + END DO + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + ! DEALLOCATE RESOURCES + + IF(rank.EQ.4)THEN + 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, cbuf_5, cbufr_5) + ELSE IF(rank.EQ.6)THEN + 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, cbuf_7, cbufr_7) + ENDIF + + CALL passed() + ! + ! end function. + ! + END SUBROUTINE test_datasetND - ! - ! compare read and write buffers. - ! - IF ( buf1 .NE. buf1r ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf1, ' and ', buf1r - STOP - ENDIF - - CALL passed() - - - !------------------------------------------------------------------------- - ! variable-length dataset - !------------------------------------------------------------------------- - CALL test_begin(' Make/Read datasets (vl) ') - ! - ! Create variable-length datatype. - ! - CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, type_id, errcode) - - f_ptr = C_LOC(wdata(1)) - CALL h5ltmake_dataset_f(file_id, dsetname6, 1, dims_vl, type_id, f_ptr, errcode) - - ! Read the variable-length datatype - f_ptr = C_LOC(rdata(1)) - CALL h5ltread_dataset_f(file_id, dsetname6, type_id, f_ptr, errcode) - - DO i = 1, INT(dims_vl(1)) - CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] ) - DO j = 1, rdata(i)%len - IF(ptr_r(j).NE.ptr(i)%data(j))THEN - PRINT *, 'Writing/Reading variable-length dataset failed' - STOP - ENDIF - ENDDO - ENDDO - - CALL H5Tclose_f(type_id, errcode) - DEALLOCATE(ptr) - - CALL passed() - - CALL test_begin(' Test h5ltpath_valid_f ') - ! - ! test function h5ltpath_valid_f - ! - chr_exact = "/"//dsetname2 ! test character buffer the exact size needed - CALL h5ltpath_valid_f(file_id, chr_exact, .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - chr_lg = "/"//dsetname2 ! test character buffer larger then needed - CALL h5ltpath_valid_f(file_id, chr_lg, .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL h5ltpath_valid_f(file_id, chr_lg, .FALSE., path_valid, errcode) - IF(errcode.LT.0.OR..NOT.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - ! Should fail, dataset does not exist - CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode) - IF(errcode.LT.0.OR.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .FALSE., path_valid, errcode) - IF(errcode.LT.0.OR.path_valid)THEN - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - ! 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 - PRINT *, 'error in h5ltpath_valid_f' - STOP - ENDIF - - CALL passed() - - CALL test_begin(' Get dataset dimensions/info ') !------------------------------------------------------------------------- - ! h5ltget_dataset_ndims_f + ! test_datasets !------------------------------------------------------------------------- - CALL h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) - IF ( rankr .NE. rank ) THEN - PRINT *, 'h5ltget_dataset_ndims_f return error' - STOP - ENDIF - - !------------------------------------------------------------------------- - ! test h5ltfind_dataset_f function - !------------------------------------------------------------------------- + SUBROUTINE test_datasets() + + IMPLICIT NONE + + 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 :: LEN0 = 3 + INTEGER, PARAMETER :: LEN1 = 12 + 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 + CHARACTER(LEN=5), PARAMETER :: dsetname6 = "dset6" ! Dataset name + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + INTEGER :: rankr ! Dataset rank + CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer + 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 + INTEGER :: i, j, n ! general purpose integer + INTEGER :: has ! general purpose integer + INTEGER :: type_class + INTEGER(SIZE_T) :: type_size + LOGICAL :: path_valid ! status of the path + CHARACTER(LEN=6) :: chr_exact + CHARACTER(LEN=8) :: chr_lg + TYPE(C_PTR) :: f_ptr + + ! vl data + TYPE vl + INTEGER, DIMENSION(:), POINTER :: DATA + END TYPE vl + TYPE(vl), DIMENSION(:), ALLOCATABLE, TARGET :: ptr + TYPE(hvl_t), DIMENSION(1:2), TARGET :: wdata ! Array of vlen structures + TYPE(hvl_t), DIMENSION(1:2), TARGET :: rdata ! Pointer to vlen structures + INTEGER(hsize_t), DIMENSION(1:1) :: dims_vl = (/2/) + INTEGER, DIMENSION(:), POINTER :: ptr_r + INTEGER(HID_T) :: type_id + + ! + ! 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 array. + ! + n = 1 + DO i = 1, DIM1 + buf2(i) = n + buf3(i) = n + buf4(i) = n + n = n + 1 + END DO + + ! + ! Initialize variable-length data. wdata(1) is a countdown of + ! length LEN0, wdata(2) is a Fibonacci sequence of length LEN1. + ! + wdata(1)%len = LEN0 + wdata(2)%len = LEN1 + + ALLOCATE( ptr(1:2) ) + ALLOCATE( ptr(1)%data(1:wdata(1)%len) ) + ALLOCATE( ptr(2)%data(1:wdata(2)%len) ) + + DO i=1, wdata(1)%len + ptr(1)%data(i) = wdata(1)%len - i + 1 ! 3 2 1 + ENDDO + wdata(1)%p = C_LOC(ptr(1)%data(1)) + + ptr(2)%data(1:2) = 1 + DO i = 3, wdata(2)%len + ptr(2)%data(i) = ptr(2)%data(i-1) + ptr(2)%data(i-2) ! (1 1 2 3 5 8 etc.) + ENDDO + wdata(2)%p = C_LOC(ptr(2)%data(1)) + + !------------------------------------------------------------------------- + ! int + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (integer) ') + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_int_f(file_id, dsetname2, rank, dims, buf2, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_int_f(file_id, dsetname2, 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' + PRINT *, bufr2(i), ' and ', buf2(i) + STOP + ENDIF + END DO + + CALL passed() + + + !------------------------------------------------------------------------- + ! real + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (float) ') + + + ! + ! write dataset. + ! + f_ptr = C_LOC(buf3(1)) + CALL h5ltmake_dataset_f(file_id, dsetname3, rank, dims, H5T_NATIVE_REAL, f_ptr, errcode) + + ! + ! read dataset. + ! + f_ptr = C_LOC(bufr3(1)) + CALL h5ltread_dataset_f(file_id, dsetname3, H5T_NATIVE_REAL, f_ptr, errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf3(i) .NE. bufr3(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr3(i), ' and ', buf3(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! double + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (double) ') + + + ! + ! write dataset. + ! + !f_ptr = C_LOC(buf4(1)) + !CALL h5ltmake_dataset_f(file_id, dsetname4, rank, dims, H5T_NATIVE_DOUBLE, f_ptr, errcode) + CALL h5ltmake_dataset_double_f(file_id, dsetname4, rank, dims, buf4, errcode) + + ! + ! read dataset. + ! + !f_ptr = C_LOC(buf4(1)) + !CALL h5ltread_dataset_f(file_id, dsetname4, H5T_NATIVE_DOUBLE, f_ptr, errcode) + CALL h5ltread_dataset_double_f(file_id, dsetname4, bufr4, dims, 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() + + + !------------------------------------------------------------------------- + ! string + !------------------------------------------------------------------------- + + CALL test_begin(' Make/Read datasets (string) ') + + + ! + ! write dataset. + ! + CALL h5ltmake_dataset_string_f(file_id, dsetname5, buf1, errcode) + + ! + ! read dataset. + ! + CALL h5ltread_dataset_string_f(file_id, dsetname5, buf1r, errcode) + + ! + ! compare read and write buffers. + ! + IF ( buf1 .NE. buf1r ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf1, ' and ', buf1r + STOP + ENDIF + + CALL passed() + + + !------------------------------------------------------------------------- + ! variable-length dataset + !------------------------------------------------------------------------- + CALL test_begin(' Make/Read datasets (vl) ') + ! + ! Create variable-length datatype. + ! + CALL H5Tvlen_create_f(H5T_NATIVE_INTEGER, type_id, errcode) + + f_ptr = C_LOC(wdata(1)) + CALL h5ltmake_dataset_f(file_id, dsetname6, 1, dims_vl, type_id, f_ptr, errcode) + + ! Read the variable-length datatype + f_ptr = C_LOC(rdata(1)) + CALL h5ltread_dataset_f(file_id, dsetname6, type_id, f_ptr, errcode) + + DO i = 1, INT(dims_vl(1)) + CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] ) + DO j = 1, rdata(i)%len + IF(ptr_r(j).NE.ptr(i)%data(j))THEN + PRINT *, 'Writing/Reading variable-length dataset failed' + STOP + ENDIF + ENDDO + ENDDO + + CALL H5Tclose_f(type_id, errcode) + DEALLOCATE(ptr) + + CALL passed() + + CALL test_begin(' Test h5ltpath_valid_f ') + ! + ! test function h5ltpath_valid_f + ! + chr_exact = "/"//dsetname2 ! test character buffer the exact size needed + CALL h5ltpath_valid_f(file_id, chr_exact, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + chr_lg = "/"//dsetname2 ! test character buffer larger then needed + CALL h5ltpath_valid_f(file_id, chr_lg, .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL h5ltpath_valid_f(file_id, chr_lg, .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR..NOT.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! Should fail, dataset does not exist + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .TRUE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL h5ltpath_valid_f(file_id, "/"//dsetname2//"junk", .FALSE., path_valid, errcode) + IF(errcode.LT.0.OR.path_valid)THEN + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + ! 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 + PRINT *, 'error in h5ltpath_valid_f' + STOP + ENDIF + + CALL passed() + + CALL test_begin(' Get dataset dimensions/info ') + + !------------------------------------------------------------------------- + ! h5ltget_dataset_ndims_f + !------------------------------------------------------------------------- + + CALL h5ltget_dataset_ndims_f(file_id, dsetname4, rankr, errcode) + IF ( rankr .NE. rank ) THEN + PRINT *, 'h5ltget_dataset_ndims_f return error' + STOP + ENDIF + + !------------------------------------------------------------------------- + ! test h5ltfind_dataset_f function + !------------------------------------------------------------------------- + + + has = h5ltfind_dataset_f(file_id,dsetname4) + IF ( has .NE. 1 ) THEN + PRINT *, 'h5ltfind_dataset_f return error' + STOP + ENDIF + + !------------------------------------------------------------------------- + ! test h5ltget_dataset_info_f 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 + + IF ( type_class .NE. 1 ) THEN ! H5T_FLOAT + PRINT *, 'wrong type class ' + STOP + ENDIF + + CALL passed() + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + + ! + ! end function. + ! + END SUBROUTINE test_datasets - has = h5ltfind_dataset_f(file_id,dsetname4) - IF ( has .NE. 1 ) THEN - PRINT *, 'h5ltfind_dataset_f return error' - STOP - ENDIF - !------------------------------------------------------------------------- - ! test h5ltget_dataset_info_f function + ! test_attributes !------------------------------------------------------------------------- - 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 + SUBROUTINE test_attributes() - IF ( type_class .NE. 1 ) THEN ! H5T_FLOAT - PRINT *, 'wrong type class ' - STOP - ENDIF + IMPLICIT NONE - CALL passed() - - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) - - ! - ! end function. - ! -END SUBROUTINE test_datasets - - -!------------------------------------------------------------------------- -! test_attributes -!------------------------------------------------------------------------- - -SUBROUTINE test_attributes() - - USE, INTRINSIC :: ISO_C_BINDING - USE H5LT ! module of H5LT - USE HDF5 ! module of HDF5 library - USE TSTLITE ! module for testing lite support routines - - IMPLICIT NONE - - CHARACTER(len=9), PARAMETER :: filename = "dsetf5.h5"! File name + 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, PARAMETER :: DIM1 = 10 ! Dimension of array - CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname3 = "attr3" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name - CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name - CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer + INTEGER(HID_T) :: file_id ! File identifier + ! INTEGER(HID_T) :: file_id1 + INTEGER, PARAMETER :: DIM1 = 10 ! Dimension of array + CHARACTER(LEN=5), PARAMETER :: attrname2 = "attr2" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname3 = "attr3" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname4 = "attr4" ! Attribute name + CHARACTER(LEN=5), PARAMETER :: attrname5 = "attr5" ! Attribute name + CHARACTER(LEN=8), PARAMETER :: buf1 = "mystring" ! Data buffer !!$ 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 - 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 - INTEGER :: errcode ! Error flag - INTEGER :: i, n ! general purpose integer - INTEGER(SIZE_T) size ! size of attribute array - INTEGER :: rankr ! rank - INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! attribute dimensions - INTEGER :: type_class - INTEGER(SIZE_T) :: type_size - INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions - INTEGER :: rank = 1 ! Dataset rank - CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name - INTEGER, DIMENSION(DIM1) :: buf ! Data buffer - INTEGER(SIZE_T) :: SizeOf_buf_type - TYPE(C_PTR) :: f_ptr - - ! - ! 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) - ! - ! make a dataset. - ! - CALL h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode) - - ! - ! Initialize the data array. - ! - size = DIM1 - n = 1 - DO i = 1, DIM1 - buf2(i) = n - buf3(i) = n - buf4(i) = n - n = n + 1 - END DO - - - !------------------------------------------------------------------------- - ! int - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes int ') - - - ! - ! write attribute. - ! - CALL h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode) - - ! - ! read attribute. - ! - CALL h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode) - - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf2(i) .NE. bufr2(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, bufr2(i), ' and ', buf2(i) - STOP - ENDIF - END DO - - CALL passed() - - !------------------------------------------------------------------------- - ! float - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes float ') - - - ! - ! write 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 + 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 + INTEGER :: errcode ! Error flag + INTEGER :: i, n ! general purpose integer + INTEGER(SIZE_T) size ! size of attribute array + INTEGER :: rankr ! rank + INTEGER(HSIZE_T), DIMENSION(1) :: dimsr ! attribute dimensions + INTEGER :: type_class + INTEGER(SIZE_T) :: type_size + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/DIM1/) ! Dataset dimensions + INTEGER :: rank = 1 ! Dataset rank + CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name + INTEGER, DIMENSION(DIM1) :: buf ! Data buffer + INTEGER(SIZE_T) :: SizeOf_buf_type + TYPE(C_PTR) :: f_ptr + + ! + ! 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) + ! + ! make a dataset. + ! + CALL h5ltmake_dataset_int_f(file_id, dsetname1, rank, dims, buf, errcode) + + ! + ! Initialize the data array. + ! + size = DIM1 + n = 1 + DO i = 1, DIM1 + buf2(i) = n + buf3(i) = n + buf4(i) = n + n = n + 1 + END DO + + + !------------------------------------------------------------------------- + ! int + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes int ') + + + ! + ! write attribute. + ! + CALL h5ltset_attribute_int_f(file_id,dsetname1,attrname2,buf2,size,errcode) + + ! + ! read attribute. + ! + CALL h5ltget_attribute_int_f(file_id,dsetname1,attrname2,bufr2,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, DIM1 + IF ( buf2(i) .NE. bufr2(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufr2(i), ' and ', buf2(i) + STOP + ENDIF + END DO + + CALL passed() + + !------------------------------------------------------------------------- + ! float + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes float ') + + + ! + ! write attribute. + ! #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(buf3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) + SizeOf_buf_type = STORAGE_SIZE(buf3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) #else - SizeOf_buf_type = SIZEOF(buf3(1)) + SizeOf_buf_type = SIZEOF(buf3(1)) #endif - f_ptr = C_LOC(buf3(1)) - CALL h5ltset_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL", SizeOf_buf_type, size,errcode) - !CALL h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode) - ! - ! read attribute. - ! + f_ptr = C_LOC(buf3(1)) + CALL h5ltset_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL", SizeOf_buf_type, size,errcode) + !CALL h5ltset_attribute_float_f(file_id,dsetname1,attrname3,buf3,size,errcode) + ! + ! read attribute. + ! #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(bufr3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) + SizeOf_buf_type = STORAGE_SIZE(bufr3(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) #else - SizeOf_buf_type = SIZEOF(bufr3(1)) + SizeOf_buf_type = SIZEOF(bufr3(1)) #endif - f_ptr = C_LOC(bufr3(1)) - CALL h5ltget_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL",SizeOf_buf_type,errcode) - !CALL h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode) + f_ptr = C_LOC(bufr3(1)) + CALL h5ltget_attribute_f(file_id,dsetname1,attrname3,f_ptr,"REAL",SizeOf_buf_type,errcode) + !CALL h5ltget_attribute_float_f(file_id,dsetname1,attrname3,bufr3,errcode) - ! - ! compare read and write buffers. - ! - DO i = 1, DIM1 - IF ( buf3(i) .NE. bufr3(i) ) THEN - PRINT *, 'read buffer differs from write buffer' - 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' + PRINT *, bufr3(i), ' and ', buf3(i) + STOP + ENDIF + END DO - CALL passed() + CALL passed() - !------------------------------------------------------------------------- - ! double - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! double + !------------------------------------------------------------------------- #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - SizeOf_buf_type = STORAGE_SIZE(buf4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) + SizeOf_buf_type = STORAGE_SIZE(buf4(1), c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) #else - SizeOf_buf_type = SIZEOF(buf4(1)) + SizeOf_buf_type = SIZEOF(buf4(1)) #endif - IF(SizeOf_buf_type.LT.16)THEN ! MSB can't handle 16 byte reals + 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) - - ! - ! 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 - - !------------------------------------------------------------------------- - ! string - !------------------------------------------------------------------------- - - CALL test_begin(' Set/Get attributes string ') - - ! - ! write attribute. - ! - CALL h5ltset_attribute_string_f(file_id,dsetname1,attrname5,buf1,errcode) - - ! - ! read attribute into a fortran character buf that is the same size as buf1. - ! - CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1,errcode) - - ! - ! compare read and write buffers. - ! - IF ( buf1 .NE. bufr1 ) THEN - PRINT *, 'read buffer differs from write buffer' - PRINT *, buf1, ' and ', bufr1 - STOP - ENDIF - - ! - ! read attribute into a fortran character buf that is larger then buf1. - ! - CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_lg,errcode) - - ! - ! compare read and write buffers, make sure C NULL character was removed. - ! - IF ( buf1(1:8) .NE. bufr1_lg(1:8) .AND. bufr1_lg(9:10) .NE. ' ' ) THEN - PRINT *, 'larger read buffer differs from write buffer' - PRINT *, buf1, ' and ', bufr1_lg - STOP - ENDIF - - ! - ! ** Test reading a string that was created with a C program ** - ! + 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() + + ENDIF + + !------------------------------------------------------------------------- + ! string + !------------------------------------------------------------------------- + + CALL test_begin(' Set/Get attributes string ') + + ! + ! write attribute. + ! + CALL h5ltset_attribute_string_f(file_id,dsetname1,attrname5,buf1,errcode) + + ! + ! read attribute into a fortran character buf that is the same size as buf1. + ! + CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1,errcode) + + ! + ! compare read and write buffers. + ! + IF ( buf1 .NE. bufr1 ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, buf1, ' and ', bufr1 + STOP + ENDIF + + ! + ! read attribute into a fortran character buf that is larger then buf1. + ! + CALL h5ltget_attribute_string_f(file_id,dsetname1,attrname5,bufr1_lg,errcode) + + ! + ! compare read and write buffers, make sure C NULL character was removed. + ! + IF ( buf1(1:8) .NE. bufr1_lg(1:8) .AND. bufr1_lg(9:10) .NE. ' ' ) THEN + PRINT *, 'larger read buffer differs from write buffer' + PRINT *, buf1, ' and ', bufr1_lg + STOP + ENDIF + + ! + ! ** Test reading a string that was created with a C program ** + ! !!$ CALL h5fopen_f(filename1, H5F_ACC_RDONLY_F, file_id1, errcode) !!$ @@ -1942,59 +1922,58 @@ SUBROUTINE test_attributes() !!$ CALL h5fclose_f(file_id1, errcode) - CALL passed() + CALL passed() - !------------------------------------------------------------------------- - ! get attribute rank - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! get attribute rank + !------------------------------------------------------------------------- - CALL test_begin(' Get attribute rank/info ') + CALL test_begin(' Get attribute rank/info ') - CALL h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode) + CALL h5ltget_attribute_ndims_f(file_id,dsetname1,attrname2,rankr,errcode) - IF ( rankr .NE. 1 ) THEN - PRINT *, 'h5ltget_attribute_ndims_f return error' - STOP - ENDIF + IF ( rankr .NE. 1 ) THEN + PRINT *, 'h5ltget_attribute_ndims_f return error' + STOP + ENDIF - CALL h5ltget_attribute_info_f(file_id,dsetname1,attrname2,dimsr,type_class,type_size,errcode) + CALL h5ltget_attribute_info_f(file_id,dsetname1,attrname2,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 + ! + ! compare dimensions + ! + DO i = 1, rank + IF ( dimsr(i) .NE. dims(i) ) THEN + PRINT *, 'dimensions differ ' + STOP + ENDIF + END DO - ! - ! Close the file. - ! - CALL h5fclose_f(file_id, errcode) - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) - CALL passed() - ! - ! end function. - ! -END SUBROUTINE test_attributes + CALL passed() + ! + ! end function. + ! + END SUBROUTINE test_attributes END MODULE TSTLITE_TESTS PROGRAM lite_test - + USE TSTLITE_TESTS ! module for testing lite routines - IMPLICIT NONE - + CALL test_dataset1D() CALL test_dataset2D() CALL test_dataset3D() -- cgit v0.12