diff options
Diffstat (limited to 'fortran/test/tH5P_F03.f90')
| -rw-r--r-- | fortran/test/tH5P_F03.f90 | 47 |
1 files changed, 24 insertions, 23 deletions
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index f5fd041..6039a52 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -34,7 +34,6 @@ ! ***************************************** ! *** H 5 P T E S T S ! ***************************************** - MODULE test_genprop_cls_cb1_mod ! Callback subroutine for test_genprop_class_callback @@ -70,6 +69,10 @@ CONTAINS END MODULE test_genprop_cls_cb1_mod +MODULE TH5P_F03 + +CONTAINS + !/*------------------------------------------------------------------------- ! * Function: test_create ! * @@ -90,6 +93,7 @@ END MODULE test_genprop_cls_cb1_mod SUBROUTINE test_create(total_error) USE HDF5 + USE TH5_MISC USE ISO_C_BINDING IMPLICIT NONE @@ -97,8 +101,7 @@ SUBROUTINE test_create(total_error) INTEGER(HID_T) :: fapl INTEGER(hid_t) :: file=-1, space=-1, dcpl=-1, comp_type_id=-1 - INTEGER(hid_t) :: dset1=-1, dset2=-1, dset3=-1, dset4=-1, dset5=-1, & - dset6=-1, dset7=-1, dset8=-1, dset9=-1 + INTEGER(hid_t) :: dset9=-1 INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: cur_size = (/2, 8, 8, 4, 2/) INTEGER(hsize_t), DIMENSION(1:5), PARAMETER :: ch_size= (/1, 1, 1, 4, 1/) CHARACTER(LEN=14) :: filename ='test_create.h5' @@ -112,15 +115,10 @@ SUBROUTINE test_create(total_error) END TYPE comp_datatype TYPE(comp_datatype), TARGET :: rd_c, fill_ctype - - INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype - INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype - INTEGER(SIZE_T) :: type_sized ! Size of the double datatype - INTEGER(SIZE_T) :: type_sizec ! Size of the double datatype - INTEGER(SIZE_T) :: sizeof_compound ! total size of compound INTEGER :: error INTEGER(SIZE_T) :: h5off TYPE(C_PTR) :: f_ptr + LOGICAL :: differ1, differ2 !/* ! * Create a file. @@ -166,7 +164,7 @@ SUBROUTINE test_create(total_error) CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error) CALL check("H5Pget_fill_value_f",error, total_error) - fill_ctype%y = 4444. + fill_ctype%y = 4444.D0 fill_ctype%z = 'S' fill_ctype%a = 5555. fill_ctype%x = 55 @@ -207,10 +205,10 @@ SUBROUTINE test_create(total_error) CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error) CALL check("H5Pget_fill_value_f", error, total_error) - IF( rd_c%a .NE. fill_ctype%a .OR. & - rd_c%y .NE. fill_ctype%y .OR. & - rd_c%x .NE. fill_ctype%x .OR. & - rd_c%z .NE. fill_ctype%z )THEN + IF( .NOT.dreal_eq( REAL(rd_c%a,dp), REAL(fill_ctype%a, dp)) .OR. & + .NOT.dreal_eq( REAL(rd_c%y,dp), REAL(fill_ctype%y, dp)) .OR. & + rd_c%x .NE. fill_ctype%x .OR. & + rd_c%z .NE. fill_ctype%z )THEN PRINT*,"***ERROR: Returned wrong fill value" total_error = total_error + 1 @@ -242,6 +240,7 @@ SUBROUTINE test_genprop_class_callback(total_error) ! USE HDF5 + USE TH5_MISC USE ISO_C_BINDING USE test_genprop_cls_cb1_mod IMPLICIT NONE @@ -261,8 +260,8 @@ SUBROUTINE test_genprop_class_callback(total_error) TYPE(cb_struct), TARGET :: crt_cb_struct, cls_cb_struct CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" - TYPE(C_FUNPTR) :: f1, f3, f5 - TYPE(C_PTR) :: f2, f4, f6 + TYPE(C_FUNPTR) :: f1, f5 + TYPE(C_PTR) :: f2, f6 CHARACTER(LEN=10) :: PROP1_NAME = "Property 1" INTEGER(SIZE_T) :: PROP1_SIZE = 10 @@ -379,7 +378,8 @@ END SUBROUTINE test_genprop_class_callback SUBROUTINE test_h5p_file_image(total_error) USE HDF5 - USE ISO_C_BINDING + USE TH5_MISC + USE, INTRINSIC :: iso_c_binding IMPLICIT NONE INTEGER, INTENT(INOUT) :: total_error INTEGER(hid_t) :: fapl_1 = -1 @@ -395,7 +395,6 @@ SUBROUTINE test_h5p_file_image(total_error) TYPE(C_PTR), DIMENSION(1:1) :: f_ptr2 ! Initialize file image buffer - DO i = 1, count buffer(i) = i*10 ENDDO @@ -405,11 +404,11 @@ SUBROUTINE test_h5p_file_image(total_error) CALL check("h5pcreate_f", error, total_error) ! Test with NULL ptr - f_ptr2 = C_NULL_PTR + f_ptr2(1) = C_NULL_PTR temp_size = 1 CALL h5pget_file_image_f(fapl_1, f_ptr2, temp_size, error) CALL check("h5pget_file_image_f", error, total_error) - CALL verify("h5pget_file_image_f", temp_size, 0, total_error) + CALL verify("h5pget_file_image_f", INT(temp_size), 0, total_error) ! Set file image f_ptr = C_LOC(buffer(1)) @@ -427,7 +426,7 @@ SUBROUTINE test_h5p_file_image(total_error) CALL check("h5pget_file_image_f", error, total_error) ! Check that sizes are the same, and that the buffers are identical but separate - CALL VERIFY("h5pget_file_image_f", temp_size, size, total_error) + CALL VERIFY("h5pget_file_image_f", INT(temp_size), INT(size), total_error) ! Verify the image data is correct DO i = 1, count @@ -452,10 +451,11 @@ END SUBROUTINE test_h5p_file_image SUBROUTINE external_test_offset(cleanup,total_error) USE ISO_C_BINDING + USE TH5_MISC USE HDF5 ! This module contains all necessary modules IMPLICIT NONE - INTEGER, INTENT(OUT) :: total_error + INTEGER, INTENT(INOUT) :: total_error LOGICAL, INTENT(IN) :: cleanup INTEGER(hid_t) :: fapl=-1 ! file access property list @@ -548,7 +548,7 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL h5sclose_f(hs_space, error) CALL check("h5sclose_f", error, total_error) - DO i = hs_start(1)+1, hs_start(1)+hs_count(1) + DO i = INT(hs_start(1))+1, INT(hs_start(1)+hs_count(1)) IF(whole(i) .NE. i-1)THEN WRITE(*,*) "Incorrect value(s) read." total_error = total_error + 1 @@ -576,3 +576,4 @@ SUBROUTINE external_test_offset(cleanup,total_error) CALL check("h5_cleanup_f", error, total_error) END SUBROUTINE external_test_offset +END MODULE TH5P_F03 |