mirror of
https://github.com/HDFGroup/hdf5.git
synced 2025-03-31 17:10:47 +08:00
[svn-r30078] Fixed -- HDFFV-9675 Removed unused variables in Fortran Library.
Tested Jelly.
This commit is contained in:
parent
d3396a7953
commit
0c2964383b
@ -529,7 +529,7 @@ CONTAINS
|
||||
|
||||
INTEGER(hid_t) :: file, fcpl, dataset, space
|
||||
INTEGER :: i, j, n, ios
|
||||
INTEGER(hsize_t), DIMENSION(1:2) :: dims
|
||||
INTEGER(hsize_t), DIMENSION(1:2) :: dims
|
||||
INTEGER(haddr_t) :: offset
|
||||
INTEGER, DIMENSION(1:dset_dim1,1:dset_dim2), TARGET :: rdata, data_in
|
||||
INTEGER :: error
|
||||
@ -622,6 +622,11 @@ CONTAINS
|
||||
END DO
|
||||
|
||||
CLOSE(10)
|
||||
|
||||
IF(cleanup) CALL h5_cleanup_f(fix_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)
|
||||
|
||||
END SUBROUTINE test_userblock_offset
|
||||
|
||||
|
@ -590,7 +590,7 @@ CONTAINS
|
||||
LOGICAL :: flag
|
||||
INTEGER(SIZE_T) :: obj_count, obj_countf
|
||||
INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids
|
||||
INTEGER :: i
|
||||
INTEGER(SIZE_T) :: i
|
||||
|
||||
CALL h5eset_auto_f(0, error)
|
||||
|
||||
|
@ -57,7 +57,8 @@ SUBROUTINE test_get_file_image(total_error)
|
||||
CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f
|
||||
|
||||
INTEGER, DIMENSION(1:100), TARGET :: data ! Write data
|
||||
INTEGER :: i, file_sz
|
||||
INTEGER :: file_sz
|
||||
INTEGER(size_t) :: i
|
||||
INTEGER(hid_t) :: file_id = -1 ! File identifier
|
||||
INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier
|
||||
INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier
|
||||
@ -92,7 +93,7 @@ SUBROUTINE test_get_file_image(total_error)
|
||||
|
||||
! Write some data to the data set
|
||||
DO i = 1, 100
|
||||
data(i) = i
|
||||
data(i) = INT(i)
|
||||
ENDDO
|
||||
|
||||
f_ptr = C_LOC(data(1))
|
||||
|
@ -1383,7 +1383,7 @@ END SUBROUTINE delete_by_idx
|
||||
! * Purpose: Support routine for link_info_by_idx, to verify the link
|
||||
! * info is correct for a link
|
||||
! *
|
||||
! * Note: This routine assumes that the links have been inserted in the
|
||||
! * Note: This routine assumes that the links have been inserted in the
|
||||
! * group in alphabetical order.
|
||||
! *
|
||||
! * Return: Success: 0
|
||||
|
@ -431,8 +431,6 @@ SUBROUTINE test_h5p_file_image(total_error)
|
||||
TYPE(C_PTR), DIMENSION(1:count) :: f_ptr1
|
||||
TYPE(C_PTR), DIMENSION(1:1) :: f_ptr2
|
||||
|
||||
INTEGER(HSIZE_T) :: sizeof_buffer
|
||||
|
||||
! Initialize file image buffer
|
||||
DO i = 1, count
|
||||
buffer(i) = i*10
|
||||
@ -520,7 +518,7 @@ SUBROUTINE external_test_offset(cleanup,total_error)
|
||||
! Write the data to external files directly
|
||||
DO i = 1, 4
|
||||
DO j = 1, 25
|
||||
part(j) = (i-1)*25+(j-1)
|
||||
part(j) = INT((i-1_size_t)*25_size_t+(j-1_size_t))
|
||||
ENDDO
|
||||
WRITE(ichr1,'(I1.1)') i
|
||||
filename = "extern_"//ichr1//"a.raw"
|
||||
@ -640,16 +638,13 @@ SUBROUTINE test_vds(total_error)
|
||||
|
||||
INTEGER, INTENT(INOUT) :: total_error
|
||||
|
||||
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(18) !should map to INTEGER*8 on most modern processors
|
||||
|
||||
CHARACTER(LEN=6), PARAMETER :: VFILENAME="vds.h5"
|
||||
CHARACTER(LEN=3), PARAMETER :: DATASET="VDS"
|
||||
INTEGER :: VDSDIM0
|
||||
INTEGER, PARAMETER :: VDSDIM1 = 10
|
||||
INTEGER, PARAMETER :: VDSDIM2 = 15
|
||||
INTEGER(hsize_t) :: VDSDIM0
|
||||
INTEGER(hsize_t), PARAMETER :: VDSDIM1 = 10
|
||||
INTEGER(hsize_t), PARAMETER :: VDSDIM2 = 15
|
||||
|
||||
INTEGER :: DIM0
|
||||
INTEGER(hsize_t) :: DIM0
|
||||
INTEGER, PARAMETER :: DIM0_1= 4 ! Initial size of the source datasets
|
||||
INTEGER, PARAMETER :: DIM1 = 10
|
||||
INTEGER, PARAMETER :: DIM2 = 15
|
||||
@ -663,7 +658,8 @@ SUBROUTINE test_vds(total_error)
|
||||
INTEGER(hid_t) :: vfile, file, src_space, mem_space, vspace, vdset, dset !Handles
|
||||
INTEGER(hid_t) :: dcpl, dapl
|
||||
INTEGER :: error
|
||||
INTEGER(hsize_t), DIMENSION(1:3) :: vdsdims = (/4*DIM0_1, VDSDIM1, VDSDIM2/), &
|
||||
INTEGER(hsize_t), DIMENSION(1:3) :: &
|
||||
vdsdims = (/4_hsize_t*INT(DIM0_1,hsize_t), VDSDIM1, VDSDIM2/), &
|
||||
vdsdims_max, &
|
||||
dims = (/DIM0_1, DIM1, DIM2/), &
|
||||
memdims = (/DIM0_1, DIM1, DIM2/), &
|
||||
@ -682,6 +678,7 @@ SUBROUTINE test_vds(total_error)
|
||||
INTEGER(hsize_t), DIMENSION(1:3,1:PLANE_STRIDE) :: start_correct
|
||||
|
||||
INTEGER :: i, j
|
||||
INTEGER(size_t) :: i_sz
|
||||
INTEGER :: layout ! Storage layout
|
||||
INTEGER(size_t) :: num_map ! Number of mappings
|
||||
INTEGER(size_t) :: len ! Length of the string also a RETURN value
|
||||
@ -713,7 +710,7 @@ SUBROUTINE test_vds(total_error)
|
||||
VDSDIM0 = H5S_UNLIMITED_F
|
||||
DIM0 = H5S_UNLIMITED_F
|
||||
vdsdims_max = (/VDSDIM0, VDSDIM1, VDSDIM2/)
|
||||
dims_max = (/DIM0, DIM1, DIM2/)
|
||||
dims_max = (/INT(DIM0,hsize_t), INT(DIM1,hsize_t), INT(DIM2,hsize_t)/)
|
||||
|
||||
!
|
||||
! Create source files and datasets.
|
||||
@ -951,8 +948,8 @@ SUBROUTINE test_vds(total_error)
|
||||
!
|
||||
! Get mapping parameters for each mapping.
|
||||
!
|
||||
DO i = 1, num_map
|
||||
CALL H5Pget_virtual_vspace_f(dcpl, INT(i-1,size_t), vspace, error)
|
||||
DO i_sz = 1, num_map
|
||||
CALL H5Pget_virtual_vspace_f(dcpl, INT(i_sz-1,size_t), vspace, error)
|
||||
CALL check("H5Pget_virtual_vspace_f", error, total_error)
|
||||
|
||||
CALL h5sget_select_type_f(vspace, s_type, error)
|
||||
@ -965,7 +962,7 @@ SUBROUTINE test_vds(total_error)
|
||||
CALL H5Sget_regular_hyperslab_f(vspace, start_out, stride_out, count_out, block_out, error)
|
||||
CALL check("H5Sget_regular_hyperslab_f", error, total_error)
|
||||
DO j = 1, 3
|
||||
IF(start_out(j).NE.start_correct(j,i) .OR. &
|
||||
IF(start_out(j).NE.start_correct(j,i_sz) .OR. &
|
||||
stride_out(j).NE.stride(j).OR. &
|
||||
count_out(j).NE.src_count(j))THEN
|
||||
total_error = total_error + 1
|
||||
@ -1032,7 +1029,7 @@ SUBROUTINE test_vds(total_error)
|
||||
total_error = total_error + 1
|
||||
ENDIF
|
||||
|
||||
CALL h5pget_virtual_srcspace_f(dcpl, INT(i-1,size_t), space_out, error)
|
||||
CALL h5pget_virtual_srcspace_f(dcpl, i_sz - 1_size_t, space_out, error)
|
||||
CALL check("H5Pget_virtual_srcspace_f", error, total_error)
|
||||
|
||||
CALL h5sget_select_type_f(space_out, type1, error)
|
||||
|
@ -614,15 +614,10 @@ END SUBROUTINE test_array_compound_atomic
|
||||
total_error = total_error + 1
|
||||
ENDIF
|
||||
DO k = 1, ARRAY2_DIM1
|
||||
|
||||
IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
|
||||
PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
|
||||
total_error = total_error + 1
|
||||
ENDIF
|
||||
IF(wdata(i,j)%c(k).NE.rdata(i,j)%c(k))THEN
|
||||
PRINT*, 'ERROR: Wrong character array data is read back by H5Dread_f '
|
||||
total_error = total_error + 1
|
||||
ENDIF
|
||||
CALL VERIFY("h5dread_f",wdata(i,j)%f(k),rdata(i,j)%f(k),total_error)
|
||||
IF(total_error.NE.0) PRINT*,'ERROR: Wrong real array data is read back by H5Dread_f'
|
||||
CALL VERIFY("h5dread_f",wdata(i,j)%c(k),rdata(i,j)%c(k),total_error)
|
||||
IF(total_error.NE.0) PRINT*,'ERROR: Wrong character array data is read back by H5Dread_f'
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
@ -1054,12 +1049,12 @@ END SUBROUTINE test_array_compound_atomic
|
||||
! Initialize the dset_data array.
|
||||
!
|
||||
DO i = 1, 4
|
||||
dset_data_i1(i) = HUGE(0_int_kind_1)-i
|
||||
dset_data_i4(i) = HUGE(0_int_kind_4)-i
|
||||
dset_data_i8(i) = HUGE(0_int_kind_8)-i
|
||||
dset_data_i16(i) = HUGE(0_int_kind_16)-i
|
||||
dset_data_i1(i) = HUGE(0_int_kind_1)-INT(i,int_kind_1)
|
||||
dset_data_i4(i) = HUGE(0_int_kind_4)-INT(i,int_kind_4)
|
||||
dset_data_i8(i) = HUGE(0_int_kind_8)-INT(i,int_kind_8)
|
||||
dset_data_i16(i) = HUGE(0_int_kind_16)-INT(i,int_kind_16)
|
||||
#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
|
||||
dset_data_i32(i) = HUGE(0_int_kind_32)-i
|
||||
dset_data_i32(i) = HUGE(0_int_kind_32)-INT(i,int_kind_32)
|
||||
#endif
|
||||
dset_data_r(i) = 4.0*ATAN(1.0)-REAL(i-1)
|
||||
dset_data_r7(i) = 4.0_real_kind_7*ATAN(1.0_real_kind_7)-REAL(i-1,real_kind_7)
|
||||
@ -1548,7 +1543,7 @@ SUBROUTINE t_bit(total_error)
|
||||
INTEGER :: A, B, C, D
|
||||
INTEGER :: Aw, Bw, Cw, Dw
|
||||
INTEGER :: i, j
|
||||
INTEGER, PARAMETER :: hex = Z'00000003'
|
||||
INTEGER, PARAMETER :: hex = INT(Z'00000003')
|
||||
TYPE(C_PTR) :: f_ptr
|
||||
INTEGER :: error ! Error flag
|
||||
!
|
||||
@ -2181,13 +2176,13 @@ SUBROUTINE t_vlen(total_error)
|
||||
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
|
||||
DO i=1, INT(wdata(1)%len)
|
||||
ptr(1)%data(i) = INT(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
|
||||
DO i = 3, INT(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))
|
||||
@ -2273,7 +2268,7 @@ SUBROUTINE t_vlen(total_error)
|
||||
|
||||
DO i = 1, INT(dims(1))
|
||||
CALL c_f_pointer(rdata(i)%p, ptr_r, [rdata(i)%len] )
|
||||
DO j = 1, rdata(i)%len
|
||||
DO j = 1, INT(rdata(i)%len)
|
||||
CALL VERIFY("t_vlen", ptr_r(j), ptr(i)%data(j), total_error)
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
Loading…
x
Reference in New Issue
Block a user