Skip to content

Commit

Permalink
fixed arg to C H5Dwrite_chunk
Browse files Browse the repository at this point in the history
  • Loading branch information
brtnfld committed Sep 15, 2023
1 parent 3479b51 commit 10903da
Showing 1 changed file with 10 additions and 10 deletions.
20 changes: 10 additions & 10 deletions fortran/src/H5Dff.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2402,7 +2402,7 @@ SUBROUTINE h5dread_chunk_f(dset_id, offset, filters, buf, hdferr, dxpl_id)
INTEGER(HID_T) , INTENT(IN), OPTIONAL :: dxpl_id

INTEGER(HID_T) :: dxpl_id_default
INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: offset_c
INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: c_offset
INTEGER(HSIZE_T) :: i, rank
INTEGER(C_INT32_T) :: c_filters

Expand All @@ -2427,7 +2427,7 @@ END FUNCTION H5Dread_chunk

rank = SIZE(offset, KIND=HSIZE_T)

ALLOCATE(offset_c(rank), STAT=hdferr)
ALLOCATE(c_offset(rank), STAT=hdferr)
IF (hdferr .NE. 0 ) THEN
hdferr = -1
RETURN
Expand All @@ -2437,14 +2437,14 @@ END FUNCTION H5Dread_chunk
! Reverse dimensions due to C-FORTRAN storage order
!
DO i = 1, rank
offset_c(i) = offset(rank - i + 1)
c_offset(i) = offset(rank - i + 1)
ENDDO

hdferr = INT(H5Dread_chunk(dset_id, dxpl_id_default, offset_c, c_filters, buf))
hdferr = INT(H5Dread_chunk(dset_id, dxpl_id_default, c_offset, c_filters, buf))

filters = INT(c_filters)

DEALLOCATE(offset_c)
DEALLOCATE(c_offset)

END SUBROUTINE h5dread_chunk_f

Expand Down Expand Up @@ -2475,7 +2475,7 @@ SUBROUTINE h5dwrite_chunk_f(dset_id, filters, offset, data_size, buf, hdferr, dx
INTEGER(HID_T) , INTENT(IN), OPTIONAL :: dxpl_id

INTEGER(HID_T) :: dxpl_id_default
INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: offset_c
INTEGER(HSIZE_T), DIMENSION(:), ALLOCATABLE :: c_offset
INTEGER(HSIZE_T) :: i, rank
INTEGER(C_INT32_T) :: c_filters

Expand All @@ -2499,7 +2499,7 @@ END FUNCTION H5Dwrite_chunk

rank = SIZE(offset, KIND=HSIZE_T)

ALLOCATE(offset_c(rank), STAT=hdferr)
ALLOCATE(c_offset(rank), STAT=hdferr)
IF (hdferr .NE. 0 ) THEN
hdferr = -1
RETURN
Expand All @@ -2509,14 +2509,14 @@ END FUNCTION H5Dwrite_chunk
! Reverse dimensions due to C-FORTRAN storage order
!
DO i = 1, rank
offset_c(i) = offset(rank - i + 1)
c_offset(i) = offset(rank - i + 1)
ENDDO

c_filters = INT(filters, C_INT32_T)

hdferr = INT(H5Dwrite_chunk(dset_id, dxpl_id_default, filters, offset_c, data_size, buf))
hdferr = INT(H5Dwrite_chunk(dset_id, dxpl_id_default, c_filters, c_offset, data_size, buf))

DEALLOCATE(offset_c)
DEALLOCATE(c_offset)

END SUBROUTINE h5dwrite_chunk_f

Expand Down

0 comments on commit 10903da

Please sign in to comment.