diff options
Diffstat (limited to 'hl/fortran/test')
| -rw-r--r-- | hl/fortran/test/Makefile.am | 2 | ||||
| -rw-r--r-- | hl/fortran/test/tstlite.F90 | 78 | ||||
| -rw-r--r-- | hl/fortran/test/tsttable.F90 | 242 |
3 files changed, 292 insertions, 30 deletions
diff --git a/hl/fortran/test/Makefile.am b/hl/fortran/test/Makefile.am index ca49817..32d367c 100644 --- a/hl/fortran/test/Makefile.am +++ b/hl/fortran/test/Makefile.am @@ -45,7 +45,7 @@ tstimage_SOURCES=tstimage.F90 tsttable_SOURCES=tsttable.F90 # Temporary files. -CHECK_CLEANFILES+=dsetf[1-5].h5 f1img.h5 f1tab.h5 tstds.h5 +CHECK_CLEANFILES+=dsetf[1-5].h5 f1img.h5 f[1-2]tab.h5 tstds.h5 # Mark this directory as part of the Fortran API (this affects output # from tests in conclude.am) diff --git a/hl/fortran/test/tstlite.F90 b/hl/fortran/test/tstlite.F90 index 0ba7815..3937c3c 100644 --- a/hl/fortran/test/tstlite.F90 +++ b/hl/fortran/test/tstlite.F90 @@ -418,7 +418,6 @@ SUBROUTINE test_dataset3D() #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors INTEGER(int_kind_32), DIMENSION(DIM1,DIM2,DIM3), TARGET :: dset_data_i32, data_out_i32 - INTEGER(HID_T) :: dset_id32 ! Dataset identifier CHARACTER(LEN=7), PARAMETER :: dsetname16a = "dset16a" ! Dataset name CHARACTER(LEN=7), PARAMETER :: dsetname16b = "dset16b" ! Dataset name CHARACTER(LEN=7), PARAMETER :: dsetname16c = "dset16c" ! Dataset name @@ -760,7 +759,6 @@ SUBROUTINE test_datasetND(rank) INTEGER :: type_class INTEGER(SIZE_T) :: type_size CHARACTER(LEN=1) :: ichr1 - CHARACTER(LEN=3) :: ichr3 TYPE(C_PTR) :: f_ptr INTEGER(HID_T) :: type_id @@ -1302,11 +1300,14 @@ SUBROUTINE test_datasets() 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 :: 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 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 @@ -1319,7 +1320,7 @@ SUBROUTINE test_datasets() REAL, DIMENSION(DIM1) , TARGET :: bufr3 ! Data buffer DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: buf4 ! Data buffer DOUBLE PRECISION, DIMENSION(DIM1), TARGET :: bufr4 ! Data buffer - INTEGER :: i, n ! general purpose integer + INTEGER :: i, j, n ! general purpose integer INTEGER :: has ! general purpose integer INTEGER :: type_class INTEGER(SIZE_T) :: type_size @@ -1328,6 +1329,17 @@ SUBROUTINE test_datasets() 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. ! @@ -1349,6 +1361,28 @@ SUBROUTINE test_datasets() 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 !------------------------------------------------------------------------- @@ -1432,7 +1466,6 @@ SUBROUTINE test_datasets() !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. ! @@ -1475,6 +1508,38 @@ SUBROUTINE test_datasets() 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 @@ -1530,7 +1595,6 @@ SUBROUTINE test_datasets() CALL passed() - CALL test_begin(' Get dataset dimensions/info ') !------------------------------------------------------------------------- @@ -1575,6 +1639,8 @@ SUBROUTINE test_datasets() STOP ENDIF + CALL passed() + ! ! Close the file. ! @@ -1584,14 +1650,12 @@ SUBROUTINE test_datasets() ! CALL h5close_f(errcode) - CALL passed() ! ! end function. ! END SUBROUTINE test_datasets - !------------------------------------------------------------------------- ! test_attributes !------------------------------------------------------------------------- diff --git a/hl/fortran/test/tsttable.F90 b/hl/fortran/test/tsttable.F90 index 74029a5..5c55a66 100644 --- a/hl/fortran/test/tsttable.F90 +++ b/hl/fortran/test/tsttable.F90 @@ -20,7 +20,24 @@ PROGRAM table_test + USE H5TB ! module of H5TB + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + INTEGER :: errcode = 0 + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + CALL test_table1() + CALL test_table2() + + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) END PROGRAM table_test @@ -35,13 +52,13 @@ SUBROUTINE test_table1() USE HDF5 ! module of HDF5 library IMPLICIT NONE - + CHARACTER(len=8), PARAMETER :: filename = "f1tab.h5" ! File name CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name INTEGER(HID_T) :: file_id ! File identifier INTEGER(HSIZE_T), PARAMETER :: nfields = 4 ! nfields INTEGER(HSIZE_T), PARAMETER :: nrecords = 5 ! nrecords - CHARACTER(LEN=10),DIMENSION(1:nfields) :: field_names ! field names + CHARACTER(LEN=9),DIMENSION(1:nfields) :: field_names ! field names INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offset ! field offset INTEGER(HID_T), DIMENSION(1:nfields) :: field_types ! field types INTEGER(HSIZE_T), PARAMETER :: chunk_size = 5 ! chunk size @@ -74,6 +91,7 @@ SUBROUTINE test_table1() INTEGER :: Cs_sizeof_double = H5_SIZEOF_DOUBLE ! C's sizeof double INTEGER :: SIZEOF_X LOGICAL :: Exclude_double + CHARACTER(LEN=62) :: test_txt ! Find size of DOUBLE PRECISION #ifdef H5_FORTRAN_HAVE_STORAGE_SIZE @@ -100,11 +118,6 @@ SUBROUTINE test_table1() 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) @@ -164,7 +177,8 @@ SUBROUTINE test_table1() ! make table !------------------------------------------------------------------------- - CALL test_begin(' Make table ') + test_txt = " Make table" + CALL test_begin(test_txt) CALL h5tbmake_table_f(dsetname1,& file_id,& @@ -186,7 +200,8 @@ SUBROUTINE test_table1() ! write field !------------------------------------------------------------------------- - CALL test_begin(' Read/Write field by name ') + test_txt = "Read/Write field by name" + CALL test_begin(test_txt) CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& bufs,errcode) @@ -309,7 +324,8 @@ SUBROUTINE test_table1() ! write field !------------------------------------------------------------------------- - CALL test_begin(' Read/Write field by index ') + test_txt = "Read/Write field by index" + CALL test_begin(test_txt) CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& bufs,errcode) @@ -413,8 +429,8 @@ SUBROUTINE test_table1() ! Insert field ! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) !------------------------------------------------------------------------- - - CALL test_begin(' Insert field ') + test_txt = "Insert field" + CALL test_begin(test_txt) CALL h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) CALL h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& @@ -437,7 +453,8 @@ SUBROUTINE test_table1() ! Delete field !------------------------------------------------------------------------- - CALL test_begin(' Delete field ') + test_txt = "Delete field" + CALL test_begin(test_txt) CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode) @@ -448,7 +465,8 @@ SUBROUTINE test_table1() ! Gets the number of records and fields !------------------------------------------------------------------------- - CALL test_begin(' Get table info ') + test_txt = "Get table info" + CALL test_begin(test_txt) CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) @@ -463,7 +481,8 @@ SUBROUTINE test_table1() ! Get information about fields !------------------------------------------------------------------------- - CALL test_begin(' Get fields info ') + test_txt = "Get fields info" + CALL test_begin(test_txt) CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,& field_offsetr, type_sizeout, errcode, maxlen ) @@ -502,16 +521,196 @@ SUBROUTINE test_table1() ! CALL h5fclose_f(file_id, errcode) - ! - ! Close FORTRAN predefined datatypes. - ! - CALL h5close_f(errcode) ! ! end function. ! END SUBROUTINE test_table1 +!------------------------------------------------------------------------- +! test_table2 +! Tests F2003 versions of H5TBread_table_f and H5TBmake_table_f +!------------------------------------------------------------------------- + +SUBROUTINE test_table2() + + USE H5TB ! module of H5TB + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors + INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(9) ! (18) !should map to INTEGER*8 on most modern processors + INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors + INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors + + TYPE particle_t + CHARACTER(LEN=11) :: name + INTEGER(KIND=int_kind_8) :: lati + INTEGER(KIND=int_kind_16) :: long + REAL(KIND=sp) :: pressure + REAL(KIND=dp) :: temperature + END TYPE particle_t + + INTEGER(HSIZE_T), PARAMETER :: nfields = 5 ! nfields + INTEGER(HSIZE_T), PARAMETER :: nrecords = 8 ! nrecords + + CHARACTER(len=8), PARAMETER :: filename = "f2tab.h5" ! File name + CHARACTER(LEN=5), PARAMETER :: table_name = "tabel" ! table name + CHARACTER(LEN=10), PARAMETER :: table_name_fill = "tabel_fill" ! table name + + ! Define field information + CHARACTER(LEN=11), DIMENSION(1:NFIELDS), PARAMETER :: field_names = (/& + "Name ", & + "Latitude ", & + "Longitude ", & + "Pressure ", & + "Temperature" & + /) + + INTEGER(hid_t), DIMENSION(1:nfields) :: field_type + INTEGER(hid_t) :: string_type + INTEGER(hid_t) :: file_id + INTEGER(hsize_t), PARAMETER :: chunk_size = 10 + TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: fill_data + INTEGER :: compress + INTEGER :: status + INTEGER :: i + INTEGER(SIZE_T) :: dst_size + TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: dst_buf + INTEGER(SIZE_T), DIMENSION(1:nfields) :: dst_offset + INTEGER(SIZE_T), DIMENSION(1:nfields) :: dst_sizes + TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: p_data + TYPE(particle_t), DIMENSION(1:nrecords), TARGET :: r_data + + TYPE(C_PTR) :: f_ptr1, f_ptr2, f_ptr3 + + INTEGER :: errcode + CHARACTER(LEN=62) :: test_txt + + test_txt = "Testing H5TBread_table_f and H5TBmake_table_f (F2003)" + CALL test_begin(test_txt) + + ! Define an array of Particles + p_data(1:nrecords) = (/ & + particle_t("zero ",0_int_kind_8,0_int_kind_16,0.0_sp,0.0_dp), & + particle_t("one ",10_int_kind_8,10_int_kind_16,10.0_sp,10.0_dp), & + particle_t("two ",20_int_kind_8,20_int_kind_16,20.0_sp,20.0_dp), & + particle_t("three ",30_int_kind_8,30_int_kind_16,30.0_sp,30.0_dp),& + particle_t("four ",40_int_kind_8,40_int_kind_16,40.0_sp,40.0_dp), & + particle_t("five ",50_int_kind_8,50_int_kind_16,50.0_sp,50.0_dp), & + particle_t("six ",60_int_kind_8,60_int_kind_16,60.0_sp,60.0_dp), & + particle_t("seven ",70_int_kind_8,70_int_kind_16,70.0_sp,70.0_dp) & + /) + + fill_data(1:nrecords) = particle_t("no data",-1_int_kind_8, -2_int_kind_16, -99.0_sp, -100.0_dp) + + compress = 0 + + dst_size = H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(2))) + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + dst_sizes(1:nfields) = (/ & + storage_size(dst_buf(1)%name)/storage_size(c_char_'a'), & + storage_size(dst_buf(1)%lati)/storage_size(c_char_'a'), & + storage_size(dst_buf(1)%long)/storage_size(c_char_'a'), & + storage_size(dst_buf(1)%pressure)/storage_size(c_char_'a'), & + storage_size(dst_buf(1)%temperature)/storage_size(c_char_'a') & + /) +#else + dst_sizes(1:nfields) = (/ & + sizeof(dst_buf(1)%name), & + sizeof(dst_buf(1)%lati), & + sizeof(dst_buf(1)%long), & + sizeof(dst_buf(1)%pressure), & + sizeof(dst_buf(1)%temperature) & + /) +#endif + + dst_offset(1:nfields) = (/ & + H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%name(1:1))), & + H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%lati)), & + H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%long)), & + H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%pressure)), & + H5OFFSETOF(C_LOC(dst_buf(1)), C_LOC(dst_buf(1)%temperature)) & + /) + + ! Initialize field_type + CALL H5Tcopy_f(H5T_FORTRAN_S1, string_type, errcode) + CALL H5Tset_size_f(string_type, INT(11,size_t), errcode) + + field_type(1:5) = (/ & + string_type,& + h5kind_to_type(KIND(dst_buf(1)%lati), H5_INTEGER_KIND),& + h5kind_to_type(KIND(dst_buf(1)%long), H5_INTEGER_KIND),& + h5kind_to_type(KIND(dst_buf(1)%pressure), H5_REAL_KIND),& + h5kind_to_type(KIND(dst_buf(1)%temperature), H5_REAL_KIND) & + /) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + ! Check setting the fill values + + f_ptr1 = C_NULL_PTR + f_ptr2 = C_LOC(fill_data(1)%name(1:1)) + + CALL h5tbmake_table_f("Table Title Fill", file_id, table_name_fill, nfields, nrecords, & + dst_size, field_names, dst_offset, field_type, & + chunk_size, f_ptr2, compress, f_ptr1, errcode ) + + f_ptr3 = C_LOC(r_data(1)%name(1:1)) + CALL h5tbread_table_f(file_id, table_name_fill, nfields, dst_size, dst_offset, dst_sizes, f_ptr3, errcode) + + DO i = 1, nfields + IF(r_data(i)%name.NE.fill_data(i)%name.OR. & + r_data(i)%lati.NE.fill_data(i)%lati.OR. & + r_data(i)%long.NE.fill_data(i)%long.OR. & + r_data(i)%pressure.NE.fill_data(i)%pressure.OR. & + r_data(i)%temperature.NE.fill_data(i)%temperature)THEN + PRINT*,'H5TBmake/read_table_f --filled-- FAILED' + STOP + ENDIF + ENDDO + + ! Check setting the table values + + f_ptr1 = C_LOC(p_data(1)%name(1:1)) + f_ptr2 = C_NULL_PTR + + CALL h5tbmake_table_f("Table Title",file_id, table_name, nfields, nrecords, & + dst_size, field_names, dst_offset, field_type, & + chunk_size, f_ptr2, compress, f_ptr1, errcode ) + + f_ptr3 = C_LOC(r_data(1)%name(1:1)) + CALL h5tbread_table_f(file_id, table_name, nfields, dst_size, dst_offset, dst_sizes, f_ptr3, errcode) + + DO i = 1, nfields + IF(r_data(i)%name.NE.p_data(i)%name.OR. & + r_data(i)%lati.NE.p_data(i)%lati.OR. & + r_data(i)%long.NE.p_data(i)%long.OR. & + r_data(i)%pressure.NE.p_data(i)%pressure.OR. & + r_data(i)%temperature.NE.p_data(i)%temperature)THEN + PRINT*,'H5TBmake/read_table_f FAILED' + STOP + ENDIF + ENDDO + + CALL passed() + + !------------------------------------------------------------------------- + ! end + !------------------------------------------------------------------------- + + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + +END SUBROUTINE test_table2 + !------------------------------------------------------------------------- ! test_begin @@ -519,8 +718,7 @@ END SUBROUTINE test_table1 SUBROUTINE test_begin(string) CHARACTER(LEN=*), INTENT(IN) :: string - WRITE(*, fmt = '(14a)', advance = 'no') string - WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' + WRITE(*, fmt = '(A)', ADVANCE = 'no') string END SUBROUTINE test_begin !------------------------------------------------------------------------- @@ -528,7 +726,7 @@ END SUBROUTINE test_begin !------------------------------------------------------------------------- SUBROUTINE passed() - WRITE(*, fmt = '(6a)') 'PASSED' + WRITE(*, fmt = '(T12,A6)') 'PASSED' END SUBROUTINE passed |