| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=dp), | intent(inout), | dimension(:), target | :: | array | ||
| real(kind=dp), | intent(inout), | optional, | dimension(:), target | :: | work | |
| logical, | intent(in), | optional | :: | reverse |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| integer(kind=int_index), | private | :: | N | ||||
| integer(kind=int64), | private, | dimension(:), pointer | :: | arri64 | |||
| integer(kind=int64), | private, | dimension(:), pointer | :: | buffer | |||
| integer(kind=int_index), | private | :: | i | ||||
| real(kind=dp), | private | :: | item | ||||
| integer(kind=int_index), | private | :: | pos | ||||
| integer(kind=int_index), | private | :: | rev_pos | ||||
| logical, | private | :: | use_internal_buffer |
module subroutine dp_radix_sort(array, work, reverse) use iso_c_binding, only: c_loc, c_f_pointer real(kind=dp), dimension(:), intent(inout), target :: array real(kind=dp), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse integer(kind=int_index) :: i, N, pos, rev_pos integer(kind=int64), dimension(:), pointer :: arri64 integer(kind=int64), dimension(:), pointer :: buffer real(kind=dp) :: item logical :: use_internal_buffer N = size(array, kind=int_index) if (present(work)) then if (size(work, kind=int_index) < N) then error stop "sp_radix_sort: work array is too small." end if use_internal_buffer = .false. call c_f_pointer(c_loc(work), buffer, [N]) else use_internal_buffer = .true. allocate (buffer(N)) end if call c_f_pointer(c_loc(array), arri64, [N]) call radix_sort_u64_helper(N, arri64, buffer) if (arri64(1) >= 0 .and. arri64(N) < 0) then pos = 1 rev_pos = N do while (arri64(rev_pos) < 0) buffer(pos) = arri64(rev_pos) pos = pos + 1 rev_pos = rev_pos - 1 end do buffer(pos:N) = arri64(1:rev_pos) arri64(:) = buffer(:) end if if (pic_optional(reverse, .false.)) then do i = 1, N/2 item = array(i) array(i) = array(N - i + 1) array(N - i + 1) = item end do end if if (use_internal_buffer) then deallocate (buffer) end if end subroutine dp_radix_sort