subroutine write_2d_multi_arr_chunk_buff( &
parent, nm, itype, arr, mem_dims, mem_offset, &
dataspace_dims, dataspace_offset)
! Write a chunk of memory from each of the MPI processes into the
! specified place in the output file.
!
! mem_dims - the dimensions of the chunk of the memory array that we
! want to write
! mem_Offset - the offset of the aforementioned chunk from the start
! of the array
! dataspace_dims
! - the dimensions of the overall dataspace
! dataspace_offset
! - the offset at which we want to write this data.
integer(hid_t), intent(in) :: parent, itype
character(*), intent(in) :: nm
integer(hsize_t) :: arr(1:,1:)
integer(hsize_t), intent(in) :: mem_dims(2), mem_offset(2)
integer(hsize_t), intent(in) :: dataspace_dims(2), dataspace_offset(2)
integer(hsize_t) :: buff_dims(2)
integer(hid_t) :: memspace, dataspace, dataset, plist_id
integer(hdf_err) :: err
integer(hsize_t), dimension(:,:), allocatable :: arr_buff
integer(hsize_t) :: block_start, block_end, block_size, this_block_size
type(c_ptr) :: cptr
integer(int32), pointer :: ptr(:)
integer(TagIntType) :: arr_buff_tag
integer :: ierr
! Create an array in the target file with the size of the total amount
! to be written out, across the processors
call h5screate_simple_f(2, dataspace_dims, dataspace, err)
! Create a property list to do multi-process writes
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, err)
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_INDEPENDENT_F, err)
! Create the dataset with the correct type
call h5dcreate_f(parent, nm, itype, dataspace, dataset, err)
!we use our own, contiguous buffers and independent MPI-IO to improve scaling
!limit buffer size to 50 MB per task
block_size=50000000/sizeof(arr(1,1))/mem_dims(1)
block_size=min(block_size,mem_dims(2))
buff_dims=[mem_dims(1), block_size]
! Create the source (memory) dataspace
call h5screate_simple_f(2, buff_dims, memspace, err)
allocate(arr_buff(mem_dims(1),block_size),stat = ierr)
if(block_size.gt.0) &
call LogMemAlloc('arr_buff',size(arr_buff),int(sizeof(arr_buff(1,1))),&
'write_2d_multi',arr_buff_tag,ierr)
block_start=1
block_end=min(block_start+block_size-1,mem_dims(2))
this_block_size=block_end-block_start+1
do while (this_block_size.gt.0)
arr_buff(:,1:this_block_size)=&
arr(1+mem_offset(1):mem_offset(1)+mem_dims(1),block_start+mem_offset(2):block_end+mem_offset(2))
!the last block might be smaller than block_size
if (this_block_size.lt.block_size) call h5sselect_hyperslab_f(memspace, &
H5S_SELECT_SET_F, [0_hsize_t,0_hsize_t], [buff_dims(1),this_block_size], err)
call h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, &
[dataspace_offset(1),dataspace_offset(2)+block_start-1], [buff_dims(1),this_block_size], err)
! Get access to a pointer to the array that will always be considered
! to have a valid type by the HDF5 library. For some reason the
! 64-bit, 2d array is not always given an interface...
cptr=arr_2d_ptr(arr_buff)
call c_f_pointer(cptr, ptr, [1])
call h5dwrite_f(dataset, itype, ptr, buff_dims, err, memspace, &
dataspace, xfer_prp=plist_id)
block_start=block_start+block_size
block_end=min(block_start+block_size-1,mem_dims(2))
this_block_size=block_end-block_start+1
end do
deallocate(arr_buff)
if(block_size.gt.0) call LogMemDealloc('write_2d_multi',arr_buff_tag)
call h5dclose_f(dataset, err)
call h5pclose_f(plist_id, err)
call h5sclose_f(dataspace, err)
call h5sclose_f(memspace, err)
end subroutine write_2d_multi_arr_chunk_buff