diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index ae27f3a81..e6af049fe 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -474,42 +474,42 @@ Sorting an array of a derived type based on the data in one component ### Performance benchmarks We have performed benchmarks of the procedures on nine different -integer arrays each of size `2**20`: +integer arrays each of size `2**16`: * Blocks - the array is divided into six blocks, each of distinct uniformly increasing integers. -* Decreasing - values decrease uniformly from `2**20-1` to `0`. +* Decreasing - values decrease uniformly from `2**16-1` to `0`. * Identical - all integers have the same value of 10. -* Increasing - values increase uniformly from `0` to `2**20-1`. +* Increasing - values increase uniformly from `0` to `2**16-1`. * Random dense - the integers are generated randomly from a set of - values from `0` to `2**18-1` so duplicates are dense. -* Random order - a set of integers from `0` to `2**20 - 1` in random + values from `0` to `2**14-1` so duplicates are dense. +* Random order - a set of integers from `0` to `2**16 - 1` in random order. * Random sparse - the integers are generated randomly from a set of - values from `0` to `2**22-1` so duplicates are sparse. + values from `0` to `2**18-1` so duplicates are sparse. * Random-3 - the increasing array has 3 random exchanges of individual elements. * Random-10 - the final ten elements of the increasing array are replaced by random values. On three different default character arrays, each of length 4 and of -size `26**4`: +size `20**4, with characters drawn from the set "a"-"p": -* Char. Decreasing - values decrease uniformly from `"zzzz"` to +* Char. Decreasing - values decrease uniformly from `"pppp"` to `"aaaa"`. * Char. Increasing - values decrease uniformly from `"aaaa"` to - `"zzzz"`. -* Char. Random - the set of strings from `"aaaa"` to `"zzzz"` in + `"pppp"`. +* Char. Random - the set of strings from `"aaaa"` to `"pppp"` in random order. On three different `string_type` arrays, each of length 4 elements and -of size `26**3`: +of size `16**3`, with characters drawn from the set "a"-"p": -* String Decreasing - values decrease uniformly from `"zzz"` to +* String Decreasing - values decrease uniformly from `"ppp"` to `"aaa"`. * String Increasing - values decrease uniformly from `"aaa"` to - `"zzz"`. -* String Random - the set of strings from `"aaa"` to `"zzz"` in + `"ppp"`. +* String Random - the set of strings from `"aaa"` to `"ppp"` in random order. These benchmarks have been performed on two different compilers, both @@ -519,101 +519,101 @@ GB 2133 MHz LPDDR3 memory. The first compiler was GNU Fortran | Type | Elements | Array Name | Method | Time (s) | |-------------|----------|-----------------|-------------|-----------| -| Integer | 1048576 | Blocks | Ord_Sort | 0.00738 | -| Integer | 1048576 | Decreasing | Ord_Sort | 0.00380 | -| Integer | 1048576 | Identical | Ord_Sort | 0.00220 | -| Integer | 1048576 | Increasing | Ord_Sort | 0.00209 | -| Integer | 1048576 | Random dense | Ord_Sort | 0.17972 | -| Integer | 1048576 | Random order | Ord_Sort | 0.17503 | -| Integer | 1048576 | Random sparse | Ord_Sort | 0.17340 | -| Integer | 1048576 | Random 3 | Ord_Sort | 0.00847 | -| Integer | 1048576 | Random 10 | Ord_Sort | 0.00484 | -| Character | 456976 | Char. Decrease | Ord_Sort | 0.00763 | -| Character | 456976 | Char. Increase | Ord_Sort | 0.00414 | -| Character | 456976 | Char. Random | Ord_Sort | 0.23746 | -| String_type | 17576 | String Decrease | Ord_Sort | 0.00543 | -| String_type | 17576 | String Increase | Ord_Sort | 0.00347 | -| String_type | 17576 | String Random | Ord_Sort | 0.09461 | -| Integer | 1048576 | Blocks | Sort | 0.10556 | -| Integer | 1048576 | Decreasing | Sort | 0.13348 | -| Integer | 1048576 | Identical | Sort | 0.15719 | -| Integer | 1048576 | Increasing | Sort | 0.05316 | -| Integer | 1048576 | Random dense | Sort | 0.15047 | -| Integer | 1048576 | Random order | Sort | 0.15176 | -| Integer | 1048576 | Random sparse | Sort | 0.15767 | -| Integer | 1048576 | Random 3 | Sort | 0.19907 | -| Integer | 1048576 | Random 10 | Sort | 0.34244 | -| Character | 456976 | Char. Decrease | Sort | 0.30723 | -| Character | 456976 | Char. Increase | Sort | 0.10984 | -| Character | 456976 | Char. Random | Sort | 0.20642 | -| String_type | 17576 | String Decrease | Sort | 0.15101 | -| String_type | 17576 | String Increase | Sort | 0.05569 | -| String_type | 17576 | String Random | Sort | 0.08499 | -| Integer | 1048576 | Blocks | Sort_Index | 0.01163 | -| Integer | 1048576 | Decreasing | Sort_Index | 0.00720 | -| Integer | 1048576 | Identical | Sort_Index | 0.00451 | -| Integer | 1048576 | Increasing | Sort_Index | 0.00452 | -| Integer | 1048576 | Random dense | Sort_Index | 0.20295 | -| Integer | 1048576 | Random order | Sort_Index | 0.20190 | -| Integer | 1048576 | Random sparse | Sort_Index | 0.20221 | -| Integer | 1048576 | Random 3 | Sort_Index | 0.01406 | -| Integer | 1048576 | Random 10 | Sort_Index | 0.00765 | -| Character | 456976 | Char. Decrease | Sort_Index | 0.00912 | -| Character | 456976 | Char. Increase | Sort_Index | 0.00515 | -| Character | 456976 | Char. Random | Sort_Index | 0.24693 | -| String_type | 17576 | String Decrease | Sort_Index | 0.00528 | -| String_type | 17576 | String Increase | Sort_Index | 0.00341 | -| String_type | 17576 | String Random | Sort_Index | 0.09554 | +| Integer | 65536 | Blocks | Ord_Sort | 0.000579 | +| Integer | 65536 | Decreasing | Ord_Sort | 0.000212 | +| Integer | 65536 | Identical | Ord_Sort | 0.000165 | +| Integer | 65536 | Increasing | Ord_Sort | 0.000131 | +| Integer | 65536 | Random dense | Ord_Sort | 0.009991 | +| Integer | 65536 | Random order | Ord_Sort | 0.008574 | +| Integer | 65536 | Random sparse | Ord_Sort | 0.010504 | +| Integer | 65536 | Random 3 | Ord_Sort | 0.000532 | +| Integer | 65536 | Random 10 | Ord_Sort | 0.000315 | +| Character | 65536 | Char. Decrease | Ord_Sort | 0.001041 | +| Character | 65536 | Char. Increase | Ord_Sort | 0.000584 | +| Character | 65536 | Char. Random | Ord_Sort | 0.026273 | +| String_type | 4096 | String Decrease | Ord_Sort | 0.001202 | +| String_type | 4096 | String Increase | Ord_Sort | 0.000758 | +| String_type | 4096 | String Random | Ord_Sort | 0.018180 | +| Integer | 65536 | Blocks | Sort | 0.005073 | +| Integer | 65536 | Decreasing | Sort | 0.005830 | +| Integer | 65536 | Identical | Sort | 0.007372 | +| Integer | 65536 | Increasing | Sort | 0.002421 | +| Integer | 65536 | Random dense | Sort | 0.007006 | +| Integer | 65536 | Random order | Sort | 0.007211 | +| Integer | 65536 | Random sparse | Sort | 0.007109 | +| Integer | 65536 | Random 3 | Sort | 0.012232 | +| Integer | 65536 | Random 10 | Sort | 0.017345 | +| Character | 65536 | Char. Decrease | Sort | 0.031350 | +| Character | 65536 | Char. Increase | Sort | 0.011606 | +| Character | 65536 | Char. Random | Sort | 0.022440 | +| String_type | 4096 | String Decrease | Sort | 0.026539 | +| String_type | 4096 | String Increase | Sort | 0.009755 | +| String_type | 4096 | String Random | Sort | 0.016218 | +| Integer | 65536 | Blocks | Sort_Index | 0.000953 | +| Integer | 65536 | Decreasing | Sort_Index | 0.000418 | +| Integer | 65536 | Identical | Sort_Index | 0.000264 | +| Integer | 65536 | Increasing | Sort_Index | 0.000262 | +| Integer | 65536 | Random dense | Sort_Index | 0.009563 | +| Integer | 65536 | Random order | Sort_Index | 0.009592 | +| Integer | 65536 | Random sparse | Sort_Index | 0.009691 | +| Integer | 65536 | Random 3 | Sort_Index | 0.000781 | +| Integer | 65536 | Random 10 | Sort_Index | 0.000455 | +| Character | 65536 | Char. Decrease | Sort_Index | 0.001189 | +| Character | 65536 | Char. Increase | Sort_Index | 0.000752 | +| Character | 65536 | Char. Random | Sort_Index | 0.025767 | +| String_type | 4096 | String Decrease | Sort_Index | 0.001411 | +| String_type | 4096 | String Increase | Sort_Index | 0.000761 | +| String_type | 4096 | String Random | Sort_Index | 0.018202 | The second compiler was Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.2.0 Build 20210228_000000, with the following results: -| Type | Elements | Array Name | Method | Time (s) | +| Type | Elements | Array Name | Method | Time (s) | |-------------|----------|-----------------|-------------|-----------| -| Integer | 1048576 | Blocks | Ord_Sort | 0.00320 | -| Integer | 1048576 | Decreasing | Ord_Sort | 0.00142 | -| Integer | 1048576 | Identical | Ord_Sort | 0.00102 | -| Integer | 1048576 | Increasing | Ord_Sort | 0.00158 | -| Integer | 1048576 | Random dense | Ord_Sort | 0.09859 | -| Integer | 1048576 | Random order | Ord_Sort | 0.09704 | -| Integer | 1048576 | Random sparse | Ord_Sort | 0.09599 | -| Integer | 1048576 | Random 3 | Ord_Sort | 0.00396 | -| Integer | 1048576 | Random 10 | Ord_Sort | 0.00183 | -| Character | 456976 | Char. Decrease | Ord_Sort | 0.00763 | -| Character | 456976 | Char. Increase | Ord_Sort | 0.00341 | -| Character | 456976 | Char. Random | Ord_Sort | 0.21991 | -| String_type | 17576 | String Decrease | Ord_Sort | 0.01957 | -| String_type | 17576 | String Increase | Ord_Sort | 0.00573 | -| String_type | 17576 | String Random | Ord_Sort | 0.37850 | -| Integer | 1048576 | Blocks | Sort | 0.03668 | -| Integer | 1048576 | Decreasing | Sort | 0.04073 | -| Integer | 1048576 | Identical | Sort | 0.03884 | -| Integer | 1048576 | Increasing | Sort | 0.01279 | -| Integer | 1048576 | Random dense | Sort | 0.06945 | -| Integer | 1048576 | Random order | Sort | 0.07151 | -| Integer | 1048576 | Random sparse | Sort | 0.07224 | -| Integer | 1048576 | Random 3 | Sort | 0.07954 | -| Integer | 1048576 | Random 10 | Sort | 0.14395 | -| Character | 456976 | Char. Decrease | Sort | 0.30367 | -| Character | 456976 | Char. Increase | Sort | 0.11316 | -| Character | 456976 | Char. Random | Sort | 0.20233 | -| String_type | 17576 | String Decrease | Sort | 0.64479 | -| String_type | 17576 | String Increase | Sort | 0.23737 | -| String_type | 17576 | String Random | Sort | 0.31361 | -| Integer | 1048576 | Blocks | Sort_Index | 0.00643 | -| Integer | 1048576 | Decreasing | Sort_Index | 0.00219 | -| Integer | 1048576 | Identical | Sort_Index | 0.00126 | -| Integer | 1048576 | Increasing | Sort_Index | 0.00130 | -| Integer | 1048576 | Random dense | Sort_Index | 0.12911 | -| Integer | 1048576 | Random order | Sort_Index | 0.13024 | -| Integer | 1048576 | Random sparse | Sort_Index | 0.12956 | -| Integer | 1048576 | Random 3 | Sort_Index | 0.00781 | -| Integer | 1048576 | Random 10 | Sort_Index | 0.00281 | -| Character | 456976 | Char. Decrease | Sort_Index | 0.00779 | -| Character | 456976 | Char. Increase | Sort_Index | 0.00393 | -| Character | 456976 | Char. Random | Sort_Index | 0.22561 | -| String_type | 17576 | String Decrease | Sort_Index | 0.01878 | -| String_type | 17576 | String Increase | Sort_Index | 0.00543 | -| String_type | 17576 | String Random | Sort_Index | 0.37748 | +| Integer | 65536 | Blocks | Ord_Sort | 0.000267 | +| Integer | 65536 | Decreasing | Ord_Sort | 0.000068 | +| Integer | 65536 | Identical | Ord_Sort | 0.000056 | +| Integer | 65536 | Increasing | Ord_Sort | 0.000056 | +| Integer | 65536 | Random dense | Ord_Sort | 0.004615 | +| Integer | 65536 | Random order | Ord_Sort | 0.006325 | +| Integer | 65536 | Random sparse | Ord_Sort | 0.004601 | +| Integer | 65536 | Random 3 | Ord_Sort | 0.000193 | +| Integer | 65536 | Random 10 | Ord_Sort | 0.000101 | +| Character | 65536 | Char. Decrease | Ord_Sort | 0.001009 | +| Character | 65536 | Char. Increase | Ord_Sort | 0.000529 | +| Character | 65536 | Char. Random | Ord_Sort | 0.024547 | +| String_type | 4096 | String Decrease | Ord_Sort | 0.003381 | +| String_type | 4096 | String Increase | Ord_Sort | 0.000133 | +| String_type | 4096 | String Random | Ord_Sort | 0.051985 | +| Integer | 65536 | Blocks | Sort | 0.001614 | +| Integer | 65536 | Decreasing | Sort | 0.001783 | +| Integer | 65536 | Identical | Sort | 0.002111 | +| Integer | 65536 | Increasing | Sort | 0.000674 | +| Integer | 65536 | Random dense | Sort | 0.003574 | +| Integer | 65536 | Random order | Sort | 0.003296 | +| Integer | 65536 | Random sparse | Sort | 0.003380 | +| Integer | 65536 | Random 3 | Sort | 0.003623 | +| Integer | 65536 | Random 10 | Sort | 0.006839 | +| Character | 65536 | Char. Decrease | Sort | 0.032564 | +| Character | 65536 | Char. Increase | Sort | 0.012346 | +| Character | 65536 | Char. Random | Sort | 0.022932 | +| String_type | 4096 | String Decrease | Sort | 0.082140 | +| String_type | 4096 | String Increase | Sort | 0.029591 | +| String_type | 4096 | String Random | Sort | 0.043078 | +| Integer | 65536 | Blocks | Sort_Index | 0.000848 | +| Integer | 65536 | Decreasing | Sort_Index | 0.000103 | +| Integer | 65536 | Identical | Sort_Index | 0.000102 | +| Integer | 65536 | Increasing | Sort_Index | 0.000066 | +| Integer | 65536 | Random dense | Sort_Index | 0.006434 | +| Integer | 65536 | Random order | Sort_Index | 0.005941 | +| Integer | 65536 | Random sparse | Sort_Index | 0.005957 | +| Integer | 65536 | Random 3 | Sort_Index | 0.000326 | +| Integer | 65536 | Random 10 | Sort_Index | 0.000175 | +| Character | 65536 | Char. Decrease | Sort_Index | 0.001082 | +| Character | 65536 | Char. Increase | Sort_Index | 0.000468 | +| Character | 65536 | Char. Random | Sort_Index | 0.023100 | +| String_type | 4096 | String Decrease | Sort_Index | 0.003292 | +| String_type | 4096 | String Increase | Sort_Index | 0.000122 | +| String_type | 4096 | String Random | Sort_Index | 0.049155 | diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index f0647432d..eeb5317f5 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -369,8 +369,9 @@ module stdlib_sorting module subroutine char_ord_sort( array, work, reverse ) !! Version: experimental !! -!! `char_ord_sort( array[, work, reverse] )` sorts the input `ARRAY` of type `CHARACTER(*)` -!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs` +!! `char_ord_sort( array[, work, reverse] )` sorts the input `ARRAY` of type +!! `CHARACTER(*)` using a hybrid sort based on the `'Rust" sort` algorithm +!! found in `slice.rs` character(len=*), intent(inout) :: array(0:) character(len=len(array)), intent(out), optional :: work(0:) logical, intent(in), optional :: reverse @@ -403,8 +404,8 @@ module stdlib_sorting pure module subroutine char_sort( array, reverse ) !! Version: experimental !! -!! `char_sort( array[, reverse] )` sorts the input `ARRAY` of type `CHARACTER(*)` -!! using a hybrid sort based on the `introsort` of David Musser. +!! `char_sort( array[, reverse] )` sorts the input `ARRAY` of type +!! `CHARACTER(*)` using a hybrid sort based on the `introsort` of David Musser. !! The algorithm is of order O(N Ln(N)) for all inputs. !! Because it relies on `quicksort`, the coefficient of the O(N Ln(N)) !! behavior is small for random data compared to other sorting algorithms. diff --git a/src/tests/sorting/test_sorting.f90 b/src/tests/sorting/test_sorting.f90 index 0e71a5946..b7d348ec5 100644 --- a/src/tests/sorting/test_sorting.f90 +++ b/src/tests/sorting/test_sorting.f90 @@ -4,17 +4,19 @@ program test_sorting compiler_version use stdlib_kinds, only: int32, int64, dp, sp use stdlib_sorting - use stdlib_string_type, only: string_type, assignment(=), operator(>), operator(<), & - write(formatted) + use stdlib_string_type, only: string_type, assignment(=), operator(>), & + operator(<), write(formatted) use stdlib_error, only: check implicit none - integer(int32), parameter :: test_size = 2_int32**20 - integer(int32), parameter :: char_size = 26**4 - integer(int32), parameter :: string_size = 26**3 + integer(int32), parameter :: test_power = 16 + integer(int32), parameter :: char_set_size = 16 + integer(int32), parameter :: test_size = 2_int32**test_power + integer(int32), parameter :: char_size = char_set_size**4 + integer(int32), parameter :: string_size = char_set_size**3 integer(int32), parameter :: block_size = test_size/6 - integer, parameter :: repeat = 8 + integer, parameter :: repeat = 1 integer(int32) :: & blocks(0:test_size-1), & @@ -38,11 +40,12 @@ program test_sorting integer(int32) :: dummy(0:test_size-1) character(len=4) :: char_dummy(0:char_size-1) type(string_type) :: string_dummy(0:string_size-1) - integer(int_size) :: index(0:test_size-1) + integer(int_size) :: index(0:max(test_size, char_size, string_size)-1) integer(int32) :: work(0:test_size/2-1) character(len=4) :: char_work(0:char_size/2-1) type(string_type) :: string_work(0:string_size/2-1) - integer(int_size) :: iwork(0:test_size/2-1) + integer(int_size) :: iwork(0:max(test_size, char_size, & + string_size)/2-1) integer :: count, i, index1, index2, j, k, l, temp real(sp) :: arand, brand character(*), parameter :: filename = 'test_sorting.txt' @@ -91,10 +94,10 @@ program test_sorting end do count = 0 - do i=0, 25 - do j=0, 25 - do k=0, 25 - do l=0, 25 + do i=0, char_set_size-1 + do j=0, char_set_size-1 + do k=0, char_set_size-1 + do l=0, char_set_size-1 char_increase(count) = achar(97+i) // achar(97+j) // & achar(97+k) // achar(97+l) count = count + 1 @@ -117,9 +120,9 @@ program test_sorting end do count = 0 - do i=0, 25 - do j=0, 25 - do k=0, 25 + do i=0, char_set_size-1 + do j=0, char_set_size-1 + do k=0, char_set_size-1 string_increase(count) = achar(97+i) // achar(97+j) // & achar(97+k) count = count + 1 @@ -171,7 +174,6 @@ program test_sorting call test_string_sort_indexes( ldummy ); ltest = (ltest .and. ldummy) - call check(ltest) contains @@ -244,7 +246,7 @@ subroutine test_int_ord_sort( a, a_name, ltest ) write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Ord_Sort", tdiff/rate !reverse @@ -253,7 +255,8 @@ subroutine test_int_ord_sort( a, a_name, ltest ) call verify_reverse_sort( dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then - write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // "." + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if @@ -316,7 +319,7 @@ subroutine test_char_ord_sort( a, a_name, ltest ) write(*,'(a, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Ord_Sort", tdiff/rate !reverse @@ -326,7 +329,8 @@ subroutine test_char_ord_sort( a, a_name, ltest ) call verify_char_reverse_sort( char_dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then - write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // "." + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." write(*,*) 'i = ', i write(*,'(a, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if @@ -337,7 +341,8 @@ subroutine test_char_ord_sort( a, a_name, ltest ) call verify_char_reverse_sort( char_dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then - write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // "." + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." write(*,*) 'i = ', i write(*,'(a, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if @@ -393,7 +398,7 @@ subroutine test_string_ord_sort( a, a_name, ltest ) string_dummy(i-1:i) end if write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Ord_Sort", tdiff/rate !reverse @@ -403,7 +408,8 @@ subroutine test_string_ord_sort( a, a_name, ltest ) call verify_string_reverse_sort( string_dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then - write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // "." + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." write(*,*) 'i = ', i write(*,'(a, 2(1x,a))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) @@ -491,7 +497,7 @@ subroutine test_int_sort( a, a_name, ltest ) write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort", tdiff/rate @@ -556,7 +562,7 @@ subroutine test_char_sort( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort", tdiff/rate !reverse @@ -619,7 +625,7 @@ subroutine test_string_sort( a, a_name, ltest ) string_dummy(i-1:i) end if write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort", tdiff/rate ! reverse @@ -696,7 +702,7 @@ subroutine test_int_sort_index( a, a_name, ltest ) end do tdiff = tdiff/repeat - dummy = a(index) + dummy = a(index(0:size(a)-1)) call verify_sort( dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then @@ -705,12 +711,12 @@ subroutine test_int_sort_index( a, a_name, ltest ) write(*,'(a18, 2i7)') 'a(index(i-1:i)) = ', a(index(i-1:i)) end if write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort_Index", tdiff/rate dummy = a call sort_index( dummy, index, work, iwork, reverse=.true. ) - dummy = a(index) + dummy = a(index(size(a)-1)) call verify_reverse_sort( dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then @@ -754,13 +760,17 @@ subroutine test_char_sort_index( a, a_name, ltest ) do i = 1, repeat char_dummy = a call system_clock( t0, rate ) + call sort_index( char_dummy, index, char_work, iwork ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 end do tdiff = tdiff/repeat call verify_char_sort( char_dummy, valid, i ) + ltest = (ltest .and. valid) if ( .not. valid ) then write( *, * ) "SORT_INDEX did not sort " // a_name // "." @@ -768,7 +778,7 @@ subroutine test_char_sort_index( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'char_dummy(i-1:i) = ', char_dummy(i-1:i) end if write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort_Index", tdiff/rate end subroutine test_char_sort_index @@ -780,9 +790,11 @@ subroutine test_string_sort_indexes( ltest ) ltest = .true. - call test_string_sort_index( string_decrease, "String Decrease", ldummy ) + call test_string_sort_index( string_decrease, "String Decrease", & + ldummy ) ltest = (ltest .and. ldummy) - call test_string_sort_index( string_increase, "String Increase", ldummy ) + call test_string_sort_index( string_increase, "String Increase", & + ldummy ) ltest = (ltest .and. ldummy) call test_string_sort_index( string_rand, "String Random", ldummy ) ltest = (ltest .and. ldummy) @@ -820,7 +832,7 @@ subroutine test_string_sort_index( a, a_name, ltest ) string_dummy(i-1:i) end if write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & - 'a12, " |", F10.5, " |" )' ) & + 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort_Index", tdiff/rate end subroutine test_string_sort_index