diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index faa21f82f..3a44d84f8 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -24,17 +24,18 @@ module's `string_type` type. ## Overview of the module -The module `stdlib_sorting` defines several public entities, one -default integer parameter, `int_index`, and four overloaded +The module `stdlib_sorting` defines several public entities, two +default integer parameters, `int_index` and `int_index_low`, and four overloaded subroutines: `ORD_SORT`, `SORT`, `RADIX_SORT` and `SORT_INDEX`. The overloaded subroutines also each have several specific names for versions corresponding to different types of array arguments. -### The `int_index` parameter +### The parameters `int_index` and `int_index_low` -The `int_index` parameter is used to specify the kind of integer used -in indexing the various arrays. Currently the module sets `int_index` -to the value of `int64` from the `stdlib_kinds` module. +The parameters `int_index` and `int_index_low` are used to specify the kind of integer used +in indexing the various arrays. Currently the module sets `int_index` and +`int_index_low` +to the value of `int64` and `int32` from the `stdlib_kinds` module, respectively. ### The module subroutines @@ -414,7 +415,7 @@ It is an `intent(inout)` argument. On input it will be an array whose sorting indices are to be determined. On return it will be the sorted array. -`index`: shall be a rank one integer array of kind `int_index` and of +`index`: shall be a rank one integer array of kind `int_index` or `int_index_low` and of the size of `array`. It is an `intent(out)` argument. On return it shall have values that are the indices needed to sort the original array in the desired direction. @@ -426,8 +427,8 @@ memory for internal record keeping. If associated with an array in static storage, its use can significantly reduce the stack memory requirements for the code. Its contents on return are undefined. -`iwork` (optional): shall be a rank one integer array of kind -`int_index`, and shall have at least `size(array)/2` elements. It +`iwork` (optional): shall be a rank one integer array of the same kind +of the array `index`, and shall have at least `size(array)/2` elements. It is an `intent(out)` argument. It is intended to be used as "scratch" memory for internal record keeping. If associated with an array in static storage, its use can significantly reduce the stack memory @@ -457,6 +458,12 @@ different on return ##### Examples +Sorting a rank one array with `sort_index`: + +```Fortran +{!example/sorting/example_sort_index.f90!} +``` + Sorting a related rank one array: ```Fortran @@ -504,7 +511,7 @@ Sorting an array of a derived type based on the data in one component ```fortran subroutine sort_a_data( a_data, a, work, index, iwork ) - ! Sort `a_data` in terms or its component `a` + ! Sort `a_data` in terms of its component `a` type(a_type), intent(inout) :: a_data(:) integer(int32), intent(inout) :: a(:) integer(int32), intent(out) :: work(:) diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 416ffecdf..4628ce20c 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,4 +1,5 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) +ADD_EXAMPLE(sort_index) ADD_EXAMPLE(radix_sort) -ADD_EXAMPLE(sort_bitset) \ No newline at end of file +ADD_EXAMPLE(sort_bitset) diff --git a/example/sorting/example_sort_index.f90 b/example/sorting/example_sort_index.f90 new file mode 100644 index 000000000..d2af74027 --- /dev/null +++ b/example/sorting/example_sort_index.f90 @@ -0,0 +1,15 @@ +program example_sort_index + use stdlib_sorting, only: sort_index + implicit none + integer, allocatable :: array(:) + integer, allocatable :: index(:) + + array = [5, 4, 3, 1, 10, 4, 9] + allocate(index, mold=array) + + call sort_index(array, index) + + print *, array !print [1, 3, 4, 4, 5, 9, 10] + print *, index !print [4, 3, 2, 6, 1, 7, 5] + +end program example_sort_index diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index de135bfd0..76f1a174f 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -6,6 +6,8 @@ #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"])) #:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"])) + #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. @@ -138,6 +140,8 @@ module stdlib_sorting private integer, parameter, public :: int_index = int64 !! Integer kind for indexing + integer, parameter, public :: int_index_low = int32 !! Integer kind for indexing using less than `huge(1_int32)` values + ! Constants for use by tim_sort integer, parameter :: & @@ -147,14 +151,16 @@ module stdlib_sorting max_merge_stack = int( ceiling( log( 2._dp**64 ) / & log(1.6180339887_dp) ) ) - type run_type +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + type run_type_${namei}$ !! Version: experimental !! !! Used to pass state around in a stack among helper functions for the !! `ORD_SORT` and `SORT_INDEX` algorithms - integer(int_index) :: base = 0 - integer(int_index) :: len = 0 - end type run_type + ${ti}$ :: base = 0 + ${ti}$ :: len = 0 + end type run_type_${namei}$ +#:endfor public ord_sort !! Version: experimental @@ -515,23 +521,25 @@ module stdlib_sorting !! non-decreasing sort, but if the optional argument `REVERSE` is present !! with a value of `.TRUE.` the indices correspond to a non-increasing sort. -#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_sort_index( array, index, work, iwork, & +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, & reverse ) !! Version: experimental !! -!! `${name1}$_sort_index( array, index[, work, iwork, reverse] )` sorts +!! `${name1}$_sort_index_${namei}$( array, index[, work, iwork, reverse] )` sorts !! an input `ARRAY` of type `${t1}$` !! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs` !! and returns the sorted `ARRAY` and an array `INDEX` of indices in the !! order that would sort the input `ARRAY` in the desired direction. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(out) :: index(0:) + ${ti}$, intent(out) :: index(0:) ${t2}$, intent(out), optional :: work(0:) - integer(int_index), intent(out), optional :: iwork(0:) + ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - end subroutine ${name1}$_sort_index + end subroutine ${name1}$_sort_index_${namei}$ + #:endfor #:endfor end interface sort_index diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index efc218d56..b648cbfed 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -186,7 +186,7 @@ contains ! 1. len(-3) > len(-2) + len(-1) ! 2. len(-2) > len(-1) integer(int_index) :: r - type(run_type), intent(in), target :: runs(0:) + type(run_type_default), intent(in), target :: runs(0:) integer(int_index) :: n logical :: test @@ -277,7 +277,7 @@ contains integer(int_index) :: array_size, finish, min_run, r, r_count, & start - type(run_type) :: runs(0:max_merge_stack-1), left, right + type(run_type_default) :: runs(0:max_merge_stack-1), left, right array_size = size(array, kind=int_index) @@ -326,7 +326,7 @@ contains end do Insert if ( start == 0 .and. finish == array_size - 1 ) return - runs(r_count) = run_type( base = start, & + runs(r_count) = run_type_default( base = start, & len = finish - start + 1 ) finish = start-1 r_count = r_count + 1 @@ -342,7 +342,7 @@ contains right % base + right % len - 1 ), & left % len, buf ) - runs(r) = run_type( base = left % base, & + runs(r) = run_type_default( base = left % base, & len = left % len + right % len ) if ( r == r_count - 3 ) runs(r+1) = runs(r+2) r_count = r_count - 1 diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index 0680d1feb..bd926f7d9 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -5,6 +5,8 @@ #:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"])) #:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"])) + #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines #! This approach allows us to have the same code for all input types. @@ -66,9 +68,10 @@ submodule(stdlib_sorting) stdlib_sorting_sort_index contains -#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + #:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_sort_index( array, index, work, iwork, reverse ) + module subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, reverse ) ! A modification of `${name1}$_ord_sort` to return an array of indices that ! would perform a stable sort of the `ARRAY` as input, and also sort `ARRAY` ! as desired. The indices by default @@ -90,20 +93,28 @@ contains ! deal with Fortran arrays of intrinsic types and not the full generality ! of Rust's arrays and lists for arbitrary types. It also adds the ! estimation of the optimal `run size` as suggested in Tim Peters' -! original listsort.txt, and the optional `work` and `iwork` arraya to be +! original listsort.txt, and the optional `work` and `iwork` arrays to be ! used as scratch memory. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(out) :: index(0:) + ${ti}$, intent(out) :: index(0:) ${t3}$, intent(out), optional :: work(0:) - integer(int_index), intent(out), optional :: iwork(0:) + ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - integer(int_index) :: array_size, i, stat + ${ti}$ :: array_size, i, stat ${t2}$, allocatable :: buf(:) - integer(int_index), allocatable :: ibuf(:) + ${ti}$, allocatable :: ibuf(:) + + if ( size(array, kind=int_index) > huge(1_${ki}$) ) then + error stop "Too many entries for the kind of index." + end if - array_size = size(array, kind=int_index) + array_size = size(array, kind=${ki}$) + + if ( size(index, kind=${ki}$) < array_size ) then + error stop "index array is too small." + end if do i = 0, array_size-1 index(i) = i+1 @@ -115,11 +126,11 @@ contains ! If necessary allocate buffers to serve as scratch memory. if ( present(work) ) then - if ( size(work, kind=int_index) < array_size/2 ) then + if ( size(work, kind=${ki}$) < array_size/2 ) then error stop "work array is too small." end if if ( present(iwork) ) then - if ( size(iwork, kind=int_index) < array_size/2 ) then + if ( size(iwork, kind=${ki}$) < array_size/2 ) then error stop "iwork array is too small." endif call merge_sort( array, index, work, iwork ) @@ -137,7 +148,7 @@ contains #:endif if ( stat /= 0 ) error stop "Allocation of array buffer failed." if ( present(iwork) ) then - if ( size(iwork, kind=int_index) < array_size/2 ) then + if ( size(iwork, kind=${ki}$) < array_size/2 ) then error stop "iwork array is too small." endif call merge_sort( array, index, buf, iwork ) @@ -158,17 +169,17 @@ contains !! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is !! less than or equal to a power of two. See !! https://svn.python.org/projects/python/trunk/Objects/listsort.txt - integer(int_index) :: min_run - integer(int_index), intent(in) :: n + ${ti}$ :: min_run + ${ti}$, intent(in) :: n - integer(int_index) :: num, r + ${ti}$ :: num, r num = n - r = 0_int_index + r = 0_${ki}$ do while( num >= 64 ) - r = ior( r, iand(num, 1_int_index) ) - num = ishft(num, -1_int_index) + r = ior( r, iand(num, 1_${ki}$) ) + num = ishft(num, -1_${ki}$) end do min_run = num + r @@ -179,12 +190,12 @@ contains ! Sorts `ARRAY` using an insertion sort, while maintaining consistency in ! location of the indices in `INDEX` to the elements of `ARRAY`. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(inout) :: index(0:) + ${ti}$, intent(inout) :: index(0:) - integer(int_index) :: i, j, key_index + ${ti}$ :: i, j, key_index ${t3}$ :: key - do j=1, size(array, kind=int_index)-1 + do j=1, size(array, kind=${ki}$)-1 key = array(j) key_index = index(j) i = j - 1 @@ -208,13 +219,13 @@ contains ! 1. len(-3) > len(-2) + len(-1) ! 2. len(-2) > len(-1) - integer(int_index) :: r - type(run_type), intent(in), target :: runs(0:) + ${ti}$ :: r + type(run_type_${namei}$), intent(in), target :: runs(0:) - integer(int_index) :: n + ${ti}$ :: n logical :: test - n = size(runs, kind=int_index) + n = size(runs, kind=${ki}$) test = .false. if (n >= 2) then if ( runs( n-1 ) % base == 0 .or. & @@ -263,14 +274,14 @@ contains ! are maintained. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(inout) :: index(0:) + ${ti}$, intent(inout) :: index(0:) ${t3}$ :: tmp - integer(int_index) :: i, tmp_index + ${ti}$ :: i, tmp_index tmp = array(0) tmp_index = index(0) - find_hole: do i=1, size(array, kind=int_index)-1 + find_hole: do i=1, size(array, kind=${ki}$)-1 if ( array(i) >= tmp ) exit find_hole array(i-1) = array(i) index(i-1) = index(i) @@ -303,15 +314,15 @@ contains ! `array` are maintained. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(inout) :: index(0:) + ${ti}$, intent(inout) :: index(0:) ${t3}$, intent(inout) :: buf(0:) - integer(int_index), intent(inout) :: ibuf(0:) + ${ti}$, intent(inout) :: ibuf(0:) - integer(int_index) :: array_size, finish, min_run, r, r_count, & + ${ti}$ :: array_size, finish, min_run, r, r_count, & start - type(run_type) :: runs(0:max_merge_stack-1), left, right + type(run_type_${namei}$) :: runs(0:max_merge_stack-1), left, right - array_size = size(array, kind=int_index) + array_size = size(array, kind=${ki}$) ! Very short runs are extended using insertion sort to span at least this ! many elements. Slices of up to this length are sorted using insertion sort. @@ -359,7 +370,7 @@ contains end do Insert if ( start == 0 .and. finish == array_size - 1 ) return - runs(r_count) = run_type( base = start, & + runs(r_count) = run_type_${namei}$( base = start, & len = finish - start + 1 ) finish = start-1 r_count = r_count + 1 @@ -377,7 +388,7 @@ contains index( left % base: & right % base + right % len - 1 ), ibuf ) - runs(r) = run_type( base = left % base, & + runs(r) = run_type_${namei}$( base = left % base, & len = left % len + right % len ) if ( r == r_count - 3 ) runs(r+1) = runs(r+2) r_count = r_count - 1 @@ -396,14 +407,14 @@ contains ! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF` ! must be long enough to hold the shorter of the two runs. ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(in) :: mid + ${ti}$, intent(in) :: mid ${t3}$, intent(inout) :: buf(0:) - integer(int_index), intent(inout) :: index(0:) - integer(int_index), intent(inout) :: ibuf(0:) + ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: ibuf(0:) - integer(int_index) :: array_len, i, j, k + ${ti}$ :: array_len, i, j, k - array_len = size(array, kind=int_index) + array_len = size(array, kind=${ki}$) ! Merge first copies the shorter run into `buf`. Then, depending on which ! run was shorter, it traces the copied run and the longer run forwards @@ -461,13 +472,13 @@ contains pure subroutine reverse_segment( array, index ) ! Reverse a segment of an array in place ${t1}$, intent(inout) :: array(0:) - integer(int_index), intent(inout) :: index(0:) + ${ti}$, intent(inout) :: index(0:) - integer(int_index) :: itemp, lo, hi + ${ti}$ :: itemp, lo, hi ${t3}$ :: temp lo = 0 - hi = size( array, kind=int_index ) - 1 + hi = size( array, kind=${ki}$ ) - 1 do while( lo < hi ) temp = array(lo) array(lo) = array(hi) @@ -481,8 +492,9 @@ contains end subroutine reverse_segment - end subroutine ${name1}$_sort_index + end subroutine ${name1}$_sort_index_${namei}$ + #:endfor #:endfor end submodule stdlib_sorting_sort_index diff --git a/test/sorting/CMakeLists.txt b/test/sorting/CMakeLists.txt index bb4b27896..624b36b1e 100644 --- a/test/sorting/CMakeLists.txt +++ b/test/sorting/CMakeLists.txt @@ -1,2 +1,7 @@ -ADDTEST(sorting) +set( + fppFiles + "test_sorting.fypp" +) +fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) +ADDTEST(sorting) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.fypp similarity index 91% rename from test/sorting/test_sorting.f90 rename to test/sorting/test_sorting.fypp index 99fd35cea..1418a032f 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.fypp @@ -1,3 +1,6 @@ +#:include "common.fypp" +#:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"])) + module test_sorting use, intrinsic :: iso_fortran_env, only: compiler_version, error_unit @@ -54,14 +57,17 @@ module test_sorting type(string_type) :: string_dummy(0:string_size-1) type(bitset_large) :: bitsetl_dummy(0:bitset_size-1) type(bitset_64) :: bitset64_dummy(0:bitset_size-1) - integer(int_index) :: index(0:max(test_size, char_size, string_size)-1) + integer(int_index) :: index_default(0:max(test_size, char_size, string_size)-1) + integer(int_index_low) :: index_low(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) type(bitset_large) :: bitsetl_work(0:bitset_size/2-1) type(bitset_64) :: bitset64_work(0:bitset_size/2-1) - integer(int_index) :: iwork(0:max(test_size, char_size, & + integer(int_index) :: iwork_default(0:max(test_size, char_size, & string_size)/2-1) + integer(int_index_low) :: iwork_low(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' @@ -82,7 +88,6 @@ subroutine collect_sorting(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest('int_ord_sorts', test_int_ord_sorts), & new_unittest('char_ord_sorts', test_char_ord_sorts), & new_unittest('string_ord_sorts', test_string_ord_sorts), & new_unittest('bitset_large_ord_sorts', test_bitsetl_ord_sorts), & @@ -94,11 +99,14 @@ subroutine collect_sorting(testsuite) new_unittest('string_sorts', test_string_sorts), & new_unittest('bitset_large_sorts', test_bitsetl_sorts), & new_unittest('bitset_64_sorts', test_bitset64_sorts), & - new_unittest('int_sort_indexes', test_int_sort_indexes), & - new_unittest('char_sort_indexes', test_char_sort_indexes), & - new_unittest('string_sort_indexes', test_string_sort_indexes), & - new_unittest('bitset_large_sort_indexes', test_bitsetl_sort_indexes), & - new_unittest('bitset_64_sort_indexes', test_bitset64_sort_indexes) & +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + new_unittest('int_sort_indexes_${namei}$', test_int_sort_indexes_${namei}$), & + new_unittest('char_sort_indexes_${namei}$', test_char_sort_indexes_${namei}$), & + new_unittest('string_sort_indexes_${namei}$', test_string_sort_indexes_${namei}$), & + new_unittest('bitset_large_sort_indexes_${namei}$', test_bitsetl_sort_indexes_${namei}$), & + new_unittest('bitset_64_sort_indexes_${namei}$', test_bitset64_sort_indexes_${namei}$), & +#:endfor + new_unittest('int_ord_sorts', test_int_ord_sorts) & ] end subroutine collect_sorting @@ -1207,47 +1215,48 @@ subroutine test_bitset64_sort( a, a_name, ltest ) end if end subroutine test_bitset64_sort - subroutine test_int_sort_indexes(error) +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + subroutine test_int_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error integer(int64) :: i integer(int32), allocatable :: d1(:) - integer(int64), allocatable :: index(:) + ${ti}$, allocatable :: index(:) logical :: ltest - call test_int_sort_index( blocks, "Blocks", ltest ) + call test_int_sort_index_${namei}$( blocks, "Blocks", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( decrease, "Decreasing", ltest ) + call test_int_sort_index_${namei}$( decrease, "Decreasing", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( identical, "Identical", ltest ) + call test_int_sort_index_${namei}$( identical, "Identical", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( increase, "Increasing", ltest ) + call test_int_sort_index_${namei}$( increase, "Increasing", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( rand1, "Random dense", ltest ) + call test_int_sort_index_${namei}$( rand1, "Random dense", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( rand2, "Random order", ltest ) + call test_int_sort_index_${namei}$( rand2, "Random order", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( rand0, "Random sparse", ltest ) + call test_int_sort_index_${namei}$( rand0, "Random sparse", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( rand3, "Random 3", ltest ) + call test_int_sort_index_${namei}$( rand3, "Random 3", ltest ) call check(error, ltest) if (allocated(error)) return - call test_int_sort_index( rand10, "Random 10", ltest ) + call test_int_sort_index_${namei}$( rand10, "Random 10", ltest ) call check(error, ltest) if (allocated(error)) return @@ -1257,9 +1266,9 @@ subroutine test_int_sort_indexes(error) call verify_sort( d1, ltest, i ) call check(error, ltest) - end subroutine test_int_sort_indexes + end subroutine test_int_sort_indexes_${namei}$ - subroutine test_int_sort_index( a, a_name, ltest ) + subroutine test_int_sort_index_${namei}$( a, a_name, ltest ) integer(int32), intent(inout) :: a(:) character(*), intent(in) :: a_name logical, intent(out) :: ltest @@ -1275,57 +1284,57 @@ subroutine test_int_sort_index( a, a_name, ltest ) do i = 1, repeat dummy = a call system_clock( t0, rate ) - call sort_index( dummy, index, work, iwork ) + call sort_index( dummy, index_${namei}$, work, iwork_${namei}$ ) call system_clock( t1, rate ) tdiff = tdiff + t1 - t0 end do tdiff = tdiff/repeat - dummy = a(index(0:size(a)-1)) + dummy = a(index_${namei}$(0:size(a)-1)) call verify_sort( dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then write( *, * ) "SORT_INDEX did not sort " // a_name // "." write(*,*) 'i = ', i - write(*,'(a18, 2i7)') 'a(index(i-1:i)) = ', a(index(i-1:i)) + write(*,'(a18, 2i7)') 'a(index_${namei}$(i-1:i)) = ', a(index_${namei}$(i-1:i)) end if write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & '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(size(a)-1)) + call sort_index( dummy, index_${namei}$, work, iwork_${namei}$, reverse=.true. ) + dummy = a(index_${namei}$(size(a)-1)) call verify_reverse_sort( dummy, valid, i ) ltest = (ltest .and. valid) if ( .not. valid ) then write( *, * ) "SORT_INDEX did not reverse sort " // & a_name // "." write(*,*) 'i = ', i - write(*,'(a18, 2i7)') 'a(index(i-1:i)) = ', a(index(i-1:i)) + write(*,'(a18, 2i7)') 'a(index_${namei}$(i-1:i)) = ', a(index_${namei}$(i-1:i)) end if - end subroutine test_int_sort_index + end subroutine test_int_sort_index_${namei}$ - subroutine test_char_sort_indexes(error) + subroutine test_char_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error logical :: ltest - call test_char_sort_index( char_decrease, "Char. Decrease", ltest ) + call test_char_sort_index_${namei}$( char_decrease, "Char. Decrease", ltest ) call check(error, ltest) if (allocated(error)) return - call test_char_sort_index( char_increase, "Char. Increase", ltest ) + call test_char_sort_index_${namei}$( char_increase, "Char. Increase", ltest ) call check(error, ltest) if (allocated(error)) return - call test_char_sort_index( char_rand, "Char. Random", ltest ) + call test_char_sort_index_${namei}$( char_rand, "Char. Random", ltest ) call check(error, ltest) - end subroutine test_char_sort_indexes + end subroutine test_char_sort_indexes_${namei}$ - subroutine test_char_sort_index( a, a_name, ltest ) + subroutine test_char_sort_index_${namei}$( a, a_name, ltest ) character(len=4), intent(in) :: a(0:) character(*), intent(in) :: a_name logical, intent(out) :: ltest @@ -1342,7 +1351,7 @@ subroutine test_char_sort_index( a, a_name, ltest ) char_dummy = a call system_clock( t0, rate ) - call sort_index( char_dummy, index, char_work, iwork ) + call sort_index( char_dummy, index_${namei}$, char_work, iwork_${namei}$ ) call system_clock( t1, rate ) @@ -1362,27 +1371,27 @@ subroutine test_char_sort_index( a, a_name, ltest ) 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort_Index", tdiff/rate - end subroutine test_char_sort_index + end subroutine test_char_sort_index_${namei}$ - subroutine test_string_sort_indexes(error) + subroutine test_string_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error logical :: ltest - call test_string_sort_index( string_decrease, "String Decrease", ltest ) + call test_string_sort_index_${namei}$( string_decrease, "String Decrease", ltest ) call check(error, ltest) if (allocated(error)) return - call test_string_sort_index( string_increase, "String Increase", ltest ) + call test_string_sort_index_${namei}$( string_increase, "String Increase", ltest ) call check(error, ltest) if (allocated(error)) return - call test_string_sort_index( string_rand, "String Random", ltest ) + call test_string_sort_index_${namei}$( string_rand, "String Random", ltest ) call check(error, ltest) - end subroutine test_string_sort_indexes + end subroutine test_string_sort_indexes_${namei}$ - subroutine test_string_sort_index( a, a_name, ltest ) + subroutine test_string_sort_index_${namei}$( a, a_name, ltest ) type(string_type), intent(in) :: a(0:) character(*), intent(in) :: a_name logical, intent(out) :: ltest @@ -1398,7 +1407,7 @@ subroutine test_string_sort_index( a, a_name, ltest ) do i = 1, repeat string_dummy = a call system_clock( t0, rate ) - call sort_index( string_dummy, index, string_work, iwork ) + call sort_index( string_dummy, index_${namei}$, string_work, iwork_${namei}$ ) call system_clock( t1, rate ) tdiff = tdiff + t1 - t0 end do @@ -1416,27 +1425,27 @@ subroutine test_string_sort_index( a, a_name, ltest ) 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort_Index", tdiff/rate - end subroutine test_string_sort_index + end subroutine test_string_sort_index_${namei}$ - subroutine test_bitsetl_sort_indexes(error) + subroutine test_bitsetl_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error logical :: ltest - call test_bitsetl_sort_index( bitsetl_decrease, "Bitset Decrease", ltest ) + call test_bitsetl_sort_index_${namei}$( bitsetl_decrease, "Bitset Decrease", ltest ) call check(error, ltest) if (allocated(error)) return - call test_bitsetl_sort_index( bitsetl_increase, "Bitset Increase", ltest ) + call test_bitsetl_sort_index_${namei}$( bitsetl_increase, "Bitset Increase", ltest ) call check(error, ltest) if (allocated(error)) return - call test_bitsetl_sort_index( bitsetl_rand, "Bitset Random", ltest ) + call test_bitsetl_sort_index_${namei}$( bitsetl_rand, "Bitset Random", ltest ) call check(error, ltest) - end subroutine test_bitsetl_sort_indexes + end subroutine test_bitsetl_sort_indexes_${namei}$ - subroutine test_bitsetl_sort_index( a, a_name, ltest ) + subroutine test_bitsetl_sort_index_${namei}$( a, a_name, ltest ) type(bitset_large), intent(in) :: a(0:) character(*), intent(in) :: a_name logical, intent(out) :: ltest @@ -1453,7 +1462,7 @@ subroutine test_bitsetl_sort_index( a, a_name, ltest ) do i = 1, repeat bitsetl_dummy = a call system_clock( t0, rate ) - call sort_index( bitsetl_dummy, index, bitsetl_work, iwork ) + call sort_index( bitsetl_dummy, index_${namei}$, bitsetl_work, iwork_${namei}$ ) call system_clock( t1, rate ) tdiff = tdiff + t1 - t0 end do @@ -1473,27 +1482,27 @@ subroutine test_bitsetl_sort_index( a, a_name, ltest ) 'a12, " |", F10.6, " |" )' ) & bitset_size, a_name, "Sort_Index", tdiff/rate - end subroutine test_bitsetl_sort_index + end subroutine test_bitsetl_sort_index_${namei}$ - subroutine test_bitset64_sort_indexes(error) + subroutine test_bitset64_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error logical :: ltest - call test_bitset64_sort_index( bitset64_decrease, "Bitset Decrease", ltest ) + call test_bitset64_sort_index_${namei}$( bitset64_decrease, "Bitset Decrease", ltest ) call check(error, ltest) if (allocated(error)) return - call test_bitset64_sort_index( bitset64_increase, "Bitset Increase", ltest ) + call test_bitset64_sort_index_${namei}$( bitset64_increase, "Bitset Increase", ltest ) call check(error, ltest) if (allocated(error)) return - call test_bitset64_sort_index( bitset64_rand, "Bitset Random", ltest ) + call test_bitset64_sort_index_${namei}$( bitset64_rand, "Bitset Random", ltest ) call check(error, ltest) - end subroutine test_bitset64_sort_indexes + end subroutine test_bitset64_sort_indexes_${namei}$ - subroutine test_bitset64_sort_index( a, a_name, ltest ) + subroutine test_bitset64_sort_index_${namei}$( a, a_name, ltest ) type(bitset_64), intent(in) :: a(0:) character(*), intent(in) :: a_name logical, intent(out) :: ltest @@ -1510,7 +1519,7 @@ subroutine test_bitset64_sort_index( a, a_name, ltest ) do i = 1, repeat bitset64_dummy = a call system_clock( t0, rate ) - call sort_index( bitset64_dummy, index, bitset64_work, iwork ) + call sort_index( bitset64_dummy, index_${namei}$, bitset64_work, iwork_${namei}$ ) call system_clock( t1, rate ) tdiff = tdiff + t1 - t0 end do @@ -1530,7 +1539,8 @@ subroutine test_bitset64_sort_index( a, a_name, ltest ) 'a12, " |", F10.6, " |" )' ) & bitset_size, a_name, "Sort_Index", tdiff/rate - end subroutine test_bitset64_sort_index + end subroutine test_bitset64_sort_index_${namei}$ +#:endfor subroutine verify_sort( a, valid, i ) integer(int32), intent(in) :: a(0:)