diff options
| -rw-r--r-- | fortran/src/H5match_types.c | 46 | ||||
| -rw-r--r-- | fortran/src/H5test_kind.F90 | 48 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 198 |
3 files changed, 185 insertions, 107 deletions
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 14b76a4..d162634 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -51,6 +51,7 @@ FILE * fort_header; void writeTypedef(const char* c_typedef, const char* c_type, unsigned int size); void writeTypedefDefault(const char* c_typedef, unsigned int size); void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int size, unsigned int kind); +void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, char* kind); static void initCfile(void) @@ -100,6 +101,7 @@ initFfile(void) !\n!\n\ ! This file is automatically generated and contains HDF5 Fortran90 type definitions.\n!\n\ MODULE H5FORTRAN_TYPES\n\ + USE ISO_C_BINDING\n\ !\n\ ! HDF5 integers\n\ !\n"); @@ -137,6 +139,11 @@ void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c fprintf(fort_header, " INTEGER, PARAMETER :: %s = %u\n", fortran_type, kind); fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type); } +void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, char* kind) +{ + fprintf(fort_header, " INTEGER, PARAMETER :: %s = %s\n", fortran_type, kind); + fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type); +} int main(void) { @@ -532,12 +539,12 @@ int main(void) /* real_f */ #if defined H5_FORTRAN_HAS_REAL_NATIVE_16_KIND if(H5_C_HAS_REAL_NATIVE_16 != 0) { - writeToFiles("float","Fortran_REAL", "real_f", 16, H5_FORTRAN_HAS_REAL_NATIVE_16_KIND); + writeToFilesChr("float","Fortran_REAL", "real_f", 16, "C_LONG_DOUBLE"); } #elif defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND - writeToFiles("float", "Fortran_REAL", "real_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND); + writeToFilesChr("float", "Fortran_REAL", "real_f", 8, "C_DOUBLE"); #elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND - writeToFiles("float", "Fortran_REAL", "real_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND); + writeToFilesChr("float", "Fortran_REAL", "real_f", 4, "C_FLOAT"); #else /* Error: couldn't find a size for real_f */ return -1; @@ -546,13 +553,13 @@ int main(void) /* double_f */ #if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */ - writeToFiles("float", "Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND); + writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 16, "C_LONG_DOUBLE"); } else { #if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */ - writeToFiles("float", "Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND); + writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 8, "C_DOUBLE"); } #elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */ - writeToFiles("float", "Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND); + writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 4, "C_FLOAT"); } #else /* Error: couldn't find a size for double_f when fortran has 16 byte reals */ @@ -561,12 +568,37 @@ int main(void) #endif #elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND - writeToFiles("float", "Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND); + writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 8, "C_DOUBLE"); #else /* Error: couldn't find a size for real_f */ return -1; #endif +/* /\* real_f *\/ */ +/* if(sizeof(float) == C_LONG_DOUBLE_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_LONG_DOUBLE"); */ +/* } else if(sizeof(float) == C_DOUBLE_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_DOUBLE"); */ +/* } else if(sizeof(float) == C_FLOAT_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_FLOAT"); */ +/* } else { */ +/* /\* Error: couldn't find a size for real_f *\/ */ +/* return -1; */ +/* } */ + +/* /\* double_f *\/ */ +/* if(sizeof(double) == C_LONG_DOUBLE_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_LONG_DOUBLE"); */ +/* } else if(sizeof(double) == C_DOUBLE_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_DOUBLE"); */ +/* } else if(sizeof(double) == C_FLOAT_SIZEOF) { */ +/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_FLOAT"); */ +/* } else { */ +/* /\* Error: couldn't find a size for double_f *\/ */ +/* return -1; */ +/* } */ + + /* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03' * in order to be interoperable with C's structure, the C buffer size * H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4) diff --git a/fortran/src/H5test_kind.F90 b/fortran/src/H5test_kind.F90 index 6cd75bc..3ad1a66 100644 --- a/fortran/src/H5test_kind.F90 +++ b/fortran/src/H5test_kind.F90 @@ -49,9 +49,17 @@ #include "H5config_f.inc" PROGRAM test_kind + USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE INTEGER :: i, j, ii, ir, last, ikind_numbers(10), rkind_numbers(10) INTEGER :: ji, jr, jd +#ifdef HAVE_C_LONG_DOUBLE + REAL(KIND=C_LONG_DOUBLE) :: c_longdble +#endif + REAL(KIND=C_DOUBLE) :: c_dble + REAL(KIND=C_FLOAT) :: c_flt + INTEGER :: sizeof_var + last = -1 ii = 0 @@ -225,7 +233,8 @@ WRITE(*,'(40(A,/))') & WRITE(*,*) "PROGRAM H5test_kind" WRITE(*,*) "USE H5test_kind_mod" - WRITE(*,*) "WRITE(*,*) "" /*generating header file*/ """ + WRITE(*,*) "CHARACTER(LEN=2) :: jchr2" + WRITE(*,*) "WRITE(*,*) "" /*generated header file*/ """ ji = 0 WRITE(*, "("" CALL i"", i2.2,""()"")") ji jr = 0 @@ -240,6 +249,43 @@ WRITE(*,'(40(A,/))') & j = rkind_numbers(i) WRITE(*, "("" CALL r"", i2.2,""()"")") j ENDDO +#ifdef HAVE_C_LONG_DOUBLE + +# ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeof_var = STORAGE_SIZE(c_longdble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +# else + sizeof_var = SIZEOF(c_longdble) +# endif + + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_LONG_DOUBLE + WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND "'//"//ADJUSTL(jchr2)" + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var + WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)" +#else + WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND -1"' + WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF -1"' +#endif + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeof_var = STORAGE_SIZE(c_dble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + sizeof_var = SIZEOF(c_dble) +#endif + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_DOUBLE + WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_KIND "'//"//ADJUSTL(jchr2)" + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var + WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)" + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeof_var = STORAGE_SIZE(c_flt, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t) +#else + sizeof_var = SIZEOF(c_flt) +#endif + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_FLOAT + WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_KIND "'//"//ADJUSTL(jchr2)" + WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var + WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_SIZEOF "'//"//ADJUSTL(jchr2)" + WRITE(*,*) "END PROGRAM H5test_kind" END PROGRAM test_kind diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90 index 7822c16..8d91f66 100644 --- a/fortran/test/tH5T.f90 +++ b/fortran/test/tH5T.f90 @@ -178,47 +178,47 @@ CONTAINS ! during write/read to/from dataset with compound datatype. ! CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) - CALL check("h5pcreate_f", error, total_error) + CALL check("h5pcreate_f", error, total_error) CALL h5pset_preserve_f(plist_id, flag, error) - CALL check("h5pset_preserve_f", error, total_error) + CALL check("h5pset_preserve_f", error, total_error) ! ! Create a new file using default properties. ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) if (error .ne. 0) then write(*,*) "Cannot modify filename" stop endif CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f", error, total_error) + CALL check("h5fcreate_f", error, total_error) ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) - CALL check("h5screate_simple_f", error, total_error) + CALL check("h5screate_simple_f", error, total_error) ! ! Create compound datatype. ! ! First calculate total size by calculating sizes of each member ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error) - CALL check("h5tcopy_f", error, total_error) + CALL check("h5tcopy_f", error, total_error) sizechar = 2 CALL h5tset_size_f(dt5_id, sizechar, error) - CALL check("h5tset_size_f", error, total_error) + CALL check("h5tset_size_f", error, total_error) CALL h5tget_size_f(dt5_id, type_sizec, error) - CALL check("h5tget_size_f", error, total_error) + CALL check("h5tget_size_f", error, total_error) CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error) - CALL check("h5tget_size_f", error, total_error) + CALL check("h5tget_size_f", error, total_error) CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error) - CALL check("h5tget_size_f", error, total_error) + CALL check("h5tget_size_f", error, total_error) CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, error) - CALL check("h5tget_size_f", error, total_error) + CALL check("h5tget_size_f", error, total_error) !write(*,*) "get sizes", type_sizec, type_sizei, type_sizer, type_sized type_size = type_sizec + type_sizei + type_sized + type_sizer CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) ! ! Insert memebers ! @@ -226,19 +226,19 @@ CONTAINS ! offset = 0 CALL h5tinsert_f(dtype_id, "char_field", offset, dt5_id, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! INTEGER member ! offset = offset + type_sizec ! Offset of the second memeber is 2 CALL h5tinsert_f(dtype_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! DOUBLE PRECISION member ! offset = offset + type_sizei ! Offset of the third memeber is 6 CALL h5tinsert_f(dtype_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! REAL member ! @@ -250,70 +250,70 @@ CONTAINS ! CALL h5dcreate_f(file_id, dsetname, dtype_id, dspace_id, & dset_id, error) - CALL check("h5dcreate_f", error, total_error) + CALL check("h5dcreate_f", error, total_error) ! ! Create memory types. We have to create a compound datatype ! for each member we want to write. ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dt1_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt1_id, "char_field", offset, dt5_id, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt2_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt2_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! Write data by fields in the datatype. Fields order is not important. ! CALL h5dwrite_f(dset_id, dt4_id, real_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) + CALL check("h5dwrite_f", error, total_error) CALL h5dwrite_f(dset_id, dt1_id, char_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) + CALL check("h5dwrite_f", error, total_error) CALL h5dwrite_f(dset_id, dt3_id, double_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) + CALL check("h5dwrite_f", error, total_error) CALL h5dwrite_f(dset_id, dt2_id, int_member, data_dims, error, xfer_prp = plist_id) - CALL check("h5dwrite_f", error, total_error) + CALL check("h5dwrite_f", error, total_error) ! ! End access to the dataset and release resources used by it. ! CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) ! ! Terminate access to the data space. ! CALL h5sclose_f(dspace_id, error) - CALL check("h5sclose_f", error, total_error) + CALL check("h5sclose_f", error, total_error) ! ! Terminate access to the datatype ! CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt1_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt2_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt3_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt4_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) ! ! Create and store compound datatype with the character and @@ -321,52 +321,52 @@ CONTAINS ! type_size = type_sizec + elements*type_sizer ! Size of compound datatype CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtarray_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dtarray_id, "char_field", offset, H5T_NATIVE_CHARACTER, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) offset = type_sizec CALL h5tarray_create_f(H5T_NATIVE_REAL, array_dims_range, array_dims, arrayt_id, error) - CALL check("h5tarray_create_f", error, total_error) + CALL check("h5tarray_create_f", error, total_error) CALL h5tinsert_f(dtarray_id,"array_field", offset, arrayt_id, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) CALL h5tcommit_f(file_id, "Compound_with_array_member", dtarray_id, error) - CALL check("h5tcommit_f", error, total_error) + CALL check("h5tcommit_f", error, total_error) CALL h5tclose_f(arrayt_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dtarray_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) ! ! Close the file. ! CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) + CALL check("h5fclose_f", error, total_error) ! ! Open the file. ! CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error) - CALL check("h5fopen_f", error, total_error) + CALL check("h5fopen_f", error, total_error) ! ! Open the dataset. ! CALL h5dopen_f(file_id, dsetname, dset_id, error) - CALL check("h5dopen_f", error, total_error) + CALL check("h5dopen_f", error, total_error) ! ! Get datatype of the open dataset. ! Check it class, number of members, and member's names. ! CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f", error, total_error) + CALL check("h5dget_type_f", error, total_error) CALL h5tget_class_f(dtype_id, class, error) - CALL check("h5dget_class_f", error, total_error) + CALL check("h5dget_class_f", error, total_error) if (class .ne. H5T_COMPOUND_F) then write(*,*) " Wrong class type returned" total_error = total_error + 1 endif CALL h5tget_nmembers_f(dtype_id, num_members, error) - CALL check("h5dget_nmembers_f", error, total_error) + CALL check("h5dget_nmembers_f", error, total_error) if (num_members .ne. COMP_NUM_MEMBERS ) then write(*,*) " Wrong number of members returned" total_error = total_error + 1 @@ -377,11 +377,11 @@ CONTAINS ! do i = 1, num_members CALL h5tget_member_name_f(dtype_id, i-1, member_name, len, error) - CALL check("h5tget_member_name_f", error, total_error) + CALL check("h5tget_member_name_f", error, total_error) CALL h5tget_member_offset_f(dtype_id, i-1, offset_out, error) - CALL check("h5tget_member_offset_f", error, total_error) + CALL check("h5tget_member_offset_f", error, total_error) CALL h5tget_member_index_f(dtype_id, member_name(1:len), member_index, error) - CALL check("h5tget_member_index_f", error, total_error) + CALL check("h5tget_member_index_f", error, total_error) if(member_index .ne. i-1) then write(*,*) "Index returned is incorrect" write(*,*) member_index, i-1 @@ -394,16 +394,16 @@ CONTAINS write(*,*) "Offset of the char member is incorrect" total_error = total_error + 1 endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, dt5_id, flag, error) - CALL check("h5tequal_f", error, total_error) + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, dt5_id, flag, error) + CALL check("h5tequal_f", error, total_error) if(.not. flag) then write(*,*) "Wrong member type returned for character member" total_error = total_error + 1 endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) + CALL h5tget_member_class_f(dtype_id, i-1, class, error) + CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_STRING_F) then write(*,*) "Wrong class returned for character member" total_error = total_error + 1 @@ -413,16 +413,16 @@ CONTAINS write(*,*) "Offset of the integer member is incorrect" total_error = total_error + 1 endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_INTEGER, flag, error) - CALL check("h5tequal_f", error, total_error) + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_INTEGER, flag, error) + CALL check("h5tequal_f", error, total_error) if(.not. flag) then write(*,*) "Wrong member type returned for integer memebr" total_error = total_error + 1 endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) + CALL h5tget_member_class_f(dtype_id, i-1, class, error) + CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_INTEGER_F) then write(*,*) "Wrong class returned for INTEGER member" total_error = total_error + 1 @@ -432,16 +432,16 @@ CONTAINS write(*,*) "Offset of the double precision member is incorrect" total_error = total_error + 1 endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_DOUBLE, flag, error) - CALL check("h5tequal_f", error, total_error) + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_DOUBLE, flag, error) + CALL check("h5tequal_f", error, total_error) if(.not. flag) then write(*,*) "Wrong member type returned for double precision memebr" total_error = total_error + 1 endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) + CALL h5tget_member_class_f(dtype_id, i-1, class, error) + CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_FLOAT_F) then write(*,*) "Wrong class returned for double precision member" total_error = total_error + 1 @@ -451,16 +451,16 @@ CONTAINS write(*,*) "Offset of the real member is incorrect" total_error = total_error + 1 endif - CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) - CALL check("h5tget_member_type_f", error, total_error) - CALL h5tequal_f(membtype_id, H5T_NATIVE_REAL, flag, error) - CALL check("h5tequal_f", error, total_error) + CALL h5tget_member_type_f(dtype_id, i-1, membtype_id, error) + CALL check("h5tget_member_type_f", error, total_error) + CALL h5tequal_f(membtype_id, H5T_NATIVE_REAL, flag, error) + CALL check("h5tequal_f", error, total_error) if(.not. flag) then write(*,*) "Wrong member type returned for real memebr" total_error = total_error + 1 endif - CALL h5tget_member_class_f(dtype_id, i-1, class, error) - CALL check("h5tget_member_class_f",error, total_error) + CALL h5tget_member_class_f(dtype_id, i-1, class, error) + CALL check("h5tget_member_class_f",error, total_error) if (class .ne. H5T_FLOAT_F) then write(*,*) "Wrong class returned for real member" total_error = total_error + 1 @@ -476,22 +476,22 @@ CONTAINS ! Create memory datatype to read character member of the compound datatype. ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt2_id, error) - CALL check("h5tcopy_f", error, total_error) + CALL check("h5tcopy_f", error, total_error) sizechar = 2 CALL h5tset_size_f(dt2_id, sizechar, error) - CALL check("h5tset_size_f", error, total_error) + CALL check("h5tset_size_f", error, total_error) CALL h5tget_size_f(dt2_id, type_size, error) - CALL check("h5tget_size_f", error, total_error) + CALL check("h5tget_size_f", error, total_error) CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dt1_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt1_id, "char_field", offset, dt2_id, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! Read part of the dataset ! CALL h5dread_f(dset_id, dt1_id, char_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) + CALL check("h5dread_f", error, total_error) do i = 1, dimsize if (char_member_out(i) .ne. char_member(i)) then write(*,*) " Wrong character data is read back " @@ -500,15 +500,15 @@ CONTAINS enddo ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt5_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt5_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! Read part of the dataset ! CALL h5dread_f(dset_id, dt5_id, int_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) + CALL check("h5dread_f", error, total_error) do i = 1, dimsize if (int_member_out(i) .ne. int_member(i)) then write(*,*) " Wrong integer data is read back " @@ -518,15 +518,15 @@ CONTAINS ! ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! Read part of the dataset ! CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) + CALL check("h5dread_f", error, total_error) do i = 1, dimsize IF( .NOT.dreal_eq( REAL(double_member_out(i),dp), REAL( double_member(i), dp)) ) THEN write(*,*) " Wrong double precision data is read back " @@ -536,15 +536,15 @@ CONTAINS ! ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) - CALL check("h5tcreate_f", error, total_error) + CALL check("h5tcreate_f", error, total_error) offset = 0 CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) - CALL check("h5tinsert_f", error, total_error) + CALL check("h5tinsert_f", error, total_error) ! ! Read part of the dataset ! CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error) - CALL check("h5dread_f", error, total_error) + CALL check("h5dread_f", error, total_error) DO i = 1, dimsize IF( .NOT.dreal_eq( REAL(real_member_out(i),dp), REAL( real_member(i), dp)) ) THEN WRITE(*,*) " Wrong real precision data is read back " @@ -583,22 +583,22 @@ CONTAINS ! Close all open objects. ! CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) + CALL check("h5dclose_f", error, total_error) CALL h5tclose_f(dt1_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt2_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt3_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt4_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5tclose_f(dt5_id, error) - CALL check("h5tclose_f", error, total_error) + CALL check("h5tclose_f", error, total_error) CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f", error, total_error) + CALL check("h5fclose_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE compoundtest |