! qsort_reals.f90 --
!
! Example belonging to "Modern Fortran in Practice" by Arjen Markus
!
! This work is licensed under the Creative Commons Attribution 3.0 Unported License.
! To view a copy of this license, visit http://c...content-available-to-author-only...s.org/licenses/by/3.0/
! or send a letter to:
! Creative Commons, 444 Castro Street, Suite 900, Mountain View, California, 94041, USA.
!
! Compact implementation of the QuickSort algorithm
!
! Note:
! Because the function uses Fortran 90 features, its interface should be made
! explicit when using it in an actual program. This is easiest via a module.
!
module qsort_functions
implicit none
contains
recursive function qsort_reals( data ) result( sorted )
real, dimension(:), intent(in) :: data
real, dimension(1:size(data)) :: sorted
if ( size(data) > 1 ) then
sorted = &
(/ qsort_reals( pack( data(2:), data(2:) > data(1) ) ), &
data(1), &
qsort_reals( pack( data(2:), data(2:) <= data(1) ) ) /)
else
sorted = data
endif
end function qsort_reals
end module qsort_functions
!Тестирующая программа
program sort
use qsort_functions
implicit none
real, dimension (10000000) :: a
call random_number(a)
a = qsort_reals(a)
end program sort
ISBxc29ydF9yZWFscy5mOTAgLS0KIQohIEV4YW1wbGUgYmVsb25naW5nIHRvICJNb2Rlcm4gRm9ydHJhbiBpbiBQcmFjdGljZSIgYnkgQXJqZW4gTWFya3VzCiEKISBUaGlzIHdvcmsgaXMgbGljZW5zZWQgdW5kZXIgdGhlIENyZWF0aXZlIENvbW1vbnMgQXR0cmlidXRpb24gMy4wIFVucG9ydGVkIExpY2Vuc2UuCiEgVG8gdmlldyBhIGNvcHkgb2YgdGhpcyBsaWNlbnNlLCB2aXNpdCBodHRwOi8vYy4uLmNvbnRlbnQtYXZhaWxhYmxlLXRvLWF1dGhvci1vbmx5Li4ucy5vcmcvbGljZW5zZXMvYnkvMy4wLwohIG9yIHNlbmQgYSBsZXR0ZXIgdG86CiEgQ3JlYXRpdmUgQ29tbW9ucywgNDQ0IENhc3RybyBTdHJlZXQsIFN1aXRlIDkwMCwgTW91bnRhaW4gVmlldywgQ2FsaWZvcm5pYSwgOTQwNDEsIFVTQS4KIQohIENvbXBhY3QgaW1wbGVtZW50YXRpb24gb2YgdGhlIFF1aWNrU29ydCBhbGdvcml0aG0KIQohIE5vdGU6CiEgQmVjYXVzZSB0aGUgZnVuY3Rpb24gdXNlcyBGb3J0cmFuIDkwIGZlYXR1cmVzLCBpdHMgaW50ZXJmYWNlIHNob3VsZCBiZSBtYWRlCiEgZXhwbGljaXQgd2hlbiB1c2luZyBpdCBpbiBhbiBhY3R1YWwgcHJvZ3JhbS4gVGhpcyBpcyBlYXNpZXN0IHZpYSBhIG1vZHVsZS4KIQptb2R1bGUgcXNvcnRfZnVuY3Rpb25zCmltcGxpY2l0IG5vbmUKIGNvbnRhaW5zCnJlY3Vyc2l2ZSBmdW5jdGlvbiBxc29ydF9yZWFscyggZGF0YSApIHJlc3VsdCggc29ydGVkICkKICAgIHJlYWwsIGRpbWVuc2lvbig6KSwgaW50ZW50KGluKSA6OiBkYXRhCiAgICByZWFsLCBkaW1lbnNpb24oMTpzaXplKGRhdGEpKSA6OiBzb3J0ZWQKIAogICAgaWYgKCBzaXplKGRhdGEpID4gMSApIHRoZW4KICAgICAgICBzb3J0ZWQgPSAmCiAgICAgICAgICAgICgvIHFzb3J0X3JlYWxzKCBwYWNrKCBkYXRhKDI6KSwgZGF0YSgyOikgPiBkYXRhKDEpICkgKSwgJgogICAgICAgICAgICAgICBkYXRhKDEpLCAmCiAgICAgICAgICAgICAgIHFzb3J0X3JlYWxzKCBwYWNrKCBkYXRhKDI6KSwgZGF0YSgyOikgPD0gZGF0YSgxKSApICkgLykKICAgIGVsc2UKICAgICAgICBzb3J0ZWQgPSBkYXRhCiAgICBlbmRpZgplbmQgZnVuY3Rpb24gcXNvcnRfcmVhbHMKZW5kIG1vZHVsZSBxc29ydF9mdW5jdGlvbnMKCgoh0KLQtdGB0YLQuNGA0YPRjtGJ0LDRjyDQv9GA0L7Qs9GA0LDQvNC80LAKcHJvZ3JhbSBzb3J0CnVzZSBxc29ydF9mdW5jdGlvbnMKaW1wbGljaXQgbm9uZQpyZWFsLCBkaW1lbnNpb24gKDEwMDAwMDAwKSA6OiBhCgogICAgICAgIGNhbGwgcmFuZG9tX251bWJlcihhKQogICAgICAgIGEgPSBxc29ydF9yZWFscyhhKQoKZW5kIHByb2dyYW0gc29ydA==