diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index f37cefaec..4de232dd4 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -41,6 +41,7 @@ to the value of `int64` from the `stdlib_kinds` module. The `stdlib_sorting` module provides three different overloaded subroutines intended to sort three different kinds of arrays of data: + * `ORD_SORT` is intended to sort simple arrays of intrinsic data that have significant sections that were partially ordered before the sort; @@ -235,8 +236,9 @@ Generic subroutine. `array` : shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On input it is +`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +It is an `intent(inout)` argument. On input it is the array to be sorted. If both the type of `array` is real and at least one of the elements is a `NaN`, then the ordering of the result is undefined. Otherwise on return its elements will be sorted in order @@ -301,8 +303,9 @@ Pure generic subroutine. `array` : shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On return its +`real(sp)`, `real(dp)`, `real(qp)`. `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +It is an `intent(inout)` argument. On return its input elements will be sorted in order of non-decreasing value. @@ -405,8 +408,9 @@ Generic subroutine. `array`: shall be a rank one array of any of the types: `integer(int8)`, `integer(int16)`, `integer(int32)`, `integer(int64)`, -`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, or -`type(string_type)`. It is an `intent(inout)` argument. On input it +`real(sp)`, `real(dp)`, `real(qp)`, `character(*)`, `type(string_type)`, +`type(bitset_64)`, or `type(bitset_large)`. +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. @@ -460,60 +464,60 @@ Sorting a related rank one array: ! Sort `a`, and also sort `b` to be reorderd the same way as `a` integer, intent(inout) :: a(:) integer(int32), intent(inout) :: b(:) ! The same size as a - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - ! Find the indices to sort a + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + ! Find the indices to sort a call sort_index(a, index(1:size(a)),& work(1:size(a)/2), iwork(1:size(a)/2)) - ! Sort b based on the sorting of a - b(:) = b( index(1:size(a)) ) - end subroutine sort_related_data + ! Sort b based on the sorting of a + b(:) = b( index(1:size(a)) ) + end subroutine sort_related_data ``` Sorting a rank 2 array based on the data in a column ```Fortran - subroutine sort_related_data( array, column, work, index, iwork ) - ! Reorder rows of `array` such that `array(:, column)` is sorted - integer, intent(inout) :: array(:,:) - integer(int32), intent(in) :: column - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - integer, allocatable :: dummy(:) - integer :: i - allocate(dummy(size(array, dim=1))) - ! Extract a column of `array` - dummy(:) = array(:, column) - ! Find the indices to sort the column - call sort_index(dummy, index(1:size(dummy)),& - work(1:size(dummy)/2), iwork(1:size(dummy)/2)) - ! Sort a based on the sorting of its column - do i=1, size(array, dim=2) - array(:, i) = array(index(1:size(array, dim=1)), i) - end do - end subroutine sort_related_data + subroutine sort_related_data( array, column, work, index, iwork ) + ! Reorder rows of `array` such that `array(:, column)` is sorted + integer, intent(inout) :: array(:,:) + integer(int32), intent(in) :: column + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + integer, allocatable :: dummy(:) + integer :: i + allocate(dummy(size(array, dim=1))) + ! Extract a column of `array` + dummy(:) = array(:, column) + ! Find the indices to sort the column + call sort_index(dummy, index(1:size(dummy)),& + work(1:size(dummy)/2), iwork(1:size(dummy)/2)) + ! Sort a based on the sorting of its column + do i=1, size(array, dim=2) + array(:, i) = array(index(1:size(array, dim=1)), i) + end do + end subroutine sort_related_data ``` 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` - type(a_type), intent(inout) :: a_data(:) - integer(int32), intent(inout) :: a(:) - integer(int32), intent(out) :: work(:) - integer(int_size), intent(out) :: index(:) - integer(int_size), intent(out) :: iwork(:) - ! Extract a component of `a_data` - a(1:size(a_data)) = a_data(:) % a - ! Find the indices to sort the component - call sort_index(a(1:size(a_data)), index(1:size(a_data)),& - work(1:size(a_data)/2), iwork(1:size(a_data)/2)) - ! Sort a_data based on the sorting of that component - a_data(:) = a_data( index(1:size(a_data)) ) - end subroutine sort_a_data + subroutine sort_a_data( a_data, a, work, index, iwork ) + ! Sort `a_data` in terms or its component `a` + type(a_type), intent(inout) :: a_data(:) + integer(int32), intent(inout) :: a(:) + integer(int32), intent(out) :: work(:) + integer(int_size), intent(out) :: index(:) + integer(int_size), intent(out) :: iwork(:) + ! Extract a component of `a_data` + a(1:size(a_data)) = a_data(:) % a + ! Find the indices to sort the component + call sort_index(a(1:size(a_data)), index(1:size(a_data)),& + work(1:size(a_data)/2), iwork(1:size(a_data)/2)) + ! Sort a_data based on the sorting of that component + a_data(:) = a_data( index(1:size(a_data)) ) + end subroutine sort_a_data ``` diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 4800cc376..416ffecdf 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,3 +1,4 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) -ADD_EXAMPLE(radix_sort) \ No newline at end of file +ADD_EXAMPLE(radix_sort) +ADD_EXAMPLE(sort_bitset) \ No newline at end of file diff --git a/example/sorting/example_sort_bitset.f90 b/example/sorting/example_sort_bitset.f90 new file mode 100644 index 000000000..5d9c89f08 --- /dev/null +++ b/example/sorting/example_sort_bitset.f90 @@ -0,0 +1,45 @@ +program example_sort_bitset + use stdlib_kinds, only: int32 + use stdlib_sorting, only: sort + use stdlib_bitsets, only: bitset_large + implicit none + type(bitset_large), allocatable :: array(:) + integer(int32) :: i + + array = [bitset_l("0101"), & ! 5 + bitset_l("0100"), & ! 4 + bitset_l("0011"), & ! 3 + bitset_l("0001"), & ! 1 + bitset_l("1010"), & ! 10 + bitset_l("0100"), & ! 4 + bitset_l("1001")] ! 9 + + call sort(array) + + do i = 1, size(array) + print *, to_string(array(i)) + ! 0001 + ! 0011 + ! 0100 + ! 0100 + ! 0101 + ! 1001 + ! 1010 + end do + + deallocate(array) +contains + function bitset_l(str) result(new_bitsetl) + character(*), intent(in) :: str + type(bitset_large) :: new_bitsetl + + call new_bitsetl%from_string(str) + end function bitset_l + + function to_string(bitset) result(str) + type(bitset_large), intent(in) :: bitset + character(:), allocatable :: str + + call bitset%to_string(str) + end function to_string +end program example_sort_bitset diff --git a/src/common.fypp b/src/common.fypp index 364a8ae72..52ca02941 100644 --- a/src/common.fypp +++ b/src/common.fypp @@ -78,6 +78,11 @@ #! Collected (kind, type) tuples for string derived types #:set STRING_KINDS_TYPES = list(zip(STRING_KINDS, STRING_TYPES)) +#! Derived type bitsets +#:set BITSET_KINDS = ["bitset_64", "bitset_large"] + +#! Bitset types to be considered during templating +#:set BITSET_TYPES = ["type({})".format(k) for k in BITSET_KINDS] #! Whether Fortran 90 compatible code should be generated #:set VERSION90 = defined('VERSION90') diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 7420816e2..6975bcda1 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -4,11 +4,13 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) #: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)) #! 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. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME !! Licensing: !! @@ -129,6 +131,9 @@ module stdlib_sorting use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(>=), operator(<), operator(<=) + use stdlib_bitsets, only: bitset_64, bitset_large, & + assignment(=), operator(>), operator(>=), operator(<), operator(<=) + implicit none private @@ -165,7 +170,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the !! type of `array` is real and at least one of the elements is a !! `NaN`, then the ordering of the result is undefined. Otherwise it !! is defined to be the original elements in non-decreasing order. @@ -215,7 +221,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the type +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the type !! of `array` is real and at least one of the elements is a `NaN`, then !! the ordering of the result is undefined. Otherwise it is defined to be the !! original elements in non-decreasing order. @@ -299,7 +306,8 @@ module stdlib_sorting !! * array: the rank 1 array to be sorted. It is an `intent(inout)` !! argument of any of the types `integer(int8)`, `integer(int16)`, !! `integer(int32)`, `integer(int64)`, `real(real32)`, `real(real64)`, -!! `real(real128)`, `character(*)`, `type(string_type)`. If both the +!! `real(real128)`, `character(*)`, `type(string_type)`, +!! `type(bitset_64)`, `type(bitset_large)`. If both the !! type of `array` is real and at least one of the elements is a `NaN`, !! then the ordering of the `array` and `index` results is undefined. !! Otherwise it is defined to be as specified by reverse. @@ -410,12 +418,12 @@ module stdlib_sorting !! sorted data, having O(N) performance on uniformly non-increasing or !! non-decreasing data. -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_ord_sort( array, work, reverse ) !! Version: experimental !! !! `${name1}$_ord_sort( array )` sorts the input `ARRAY` of type `${t1}$` -!! using a hybrid sort based on the `'Rust" sort` algorithm found in `slice.rs` +!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs` ${t1}$, intent(inout) :: array(0:) ${t2}$, intent(out), optional :: work(0:) logical, intent(in), optional :: reverse @@ -476,7 +484,7 @@ module stdlib_sorting !! on the `introsort` of David Musser. !! ([Specification](../page/specs/stdlib_sorting.html#sort-sorts-an-input-array)) -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure module subroutine ${name1}$_sort( array, reverse ) !! Version: experimental !! @@ -507,15 +515,15 @@ 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 IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_sort_index( array, index, work, iwork, & reverse ) !! Version: experimental !! !! `${name1}$_sort_index( 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 +!! 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_size), intent(out) :: index(0:) diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index a5d950447..4c5ea24c7 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -3,11 +3,13 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) #: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)) #! 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. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME #:set SIGN_NAME = ["increase", "decrease"] #:set SIGN_TYPE = [">", "<"] @@ -69,7 +71,7 @@ submodule(stdlib_sorting) stdlib_sorting_ord_sort contains -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_ord_sort( array, work, reverse ) ${t1}$, intent(inout) :: array(0:) ${t3}$, intent(out), optional :: work(0:) @@ -85,7 +87,7 @@ contains #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME subroutine ${name1}$_${sname}$_ord_sort( array, work ) ! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index ecc2c3154..4a9171f77 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -3,11 +3,13 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) #: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)) #! 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. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME #:set SIGN_NAME = ["increase", "decrease"] #:set SIGN_TYPE = [">", "<"] @@ -73,7 +75,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort contains -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure module subroutine ${name1}$_sort( array, reverse ) ${t1}$, intent(inout) :: array(0:) logical, intent(in), optional :: reverse @@ -87,7 +89,7 @@ contains #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME pure subroutine ${name1}$_${sname}$_sort( array ) ! `${name1}$_${sname}$_sort( array )` sorts the input `ARRAY` of type `${t1}$` diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index b2a100d92..6f0101219 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -3,11 +3,13 @@ #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) #: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)) #! 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. -#:set IRSC_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME +#:set IRSCB_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + STRING_TYPES_ALT_NAME + CHAR_TYPES_ALT_NAME & + & + BITSET_TYPES_ALT_NAME !! Licensing: !! @@ -64,7 +66,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort_index contains -#:for t1, t2, t3, name1 in IRSC_TYPES_ALT_NAME +#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_sort_index( array, index, work, iwork, reverse ) ! A modification of `${name1}$_ord_sort` to return an array of indices that diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index c3de24c2f..4c9f1ffa5 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -5,6 +5,8 @@ module test_sorting use stdlib_sorting use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(<), write(formatted) + use stdlib_bitsets, only: bitset_64, bitset_large, & + assignment(=), operator(>), operator(<) use testdrive, only: new_unittest, unittest_type, error_type, check implicit none @@ -14,6 +16,7 @@ module test_sorting 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 :: bitset_size = char_set_size**3 integer(int32), parameter :: block_size = test_size/6 integer, parameter :: repeat = 1 @@ -36,15 +39,27 @@ module test_sorting string_decrease(0:string_size-1), & string_increase(0:string_size-1), & string_rand(0:string_size-1) + type(bitset_large) :: & + bitsetl_decrease(0:bitset_size-1), & + bitsetl_increase(0:bitset_size-1), & + bitsetl_rand(0:bitset_size-1) + type(bitset_64) :: & + bitset64_decrease(0:bitset_size-1), & + bitset64_increase(0:bitset_size-1), & + bitset64_rand(0:bitset_size-1) integer(int32) :: dummy(0:test_size-1) real(sp) :: real_dummy(0:test_size-1) character(len=4) :: char_dummy(0:char_size-1) 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_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) + type(bitset_large) :: bitsetl_work(0:bitset_size/2-1) + type(bitset_64) :: bitset64_work(0:bitset_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 @@ -53,7 +68,11 @@ module test_sorting integer :: lun character(len=4) :: char_temp type(string_type) :: string_temp + type(bitset_large) :: bitsetl_temp + type(bitset_64) :: bitset64_temp logical :: ltest, ldummy + character(32) :: bin32 + character(64) :: bin64 contains @@ -66,14 +85,20 @@ subroutine collect_sorting(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), & + new_unittest('bitset_64_ord_sorts', test_bitset64_ord_sorts), & new_unittest('int_radix_sorts', test_int_radix_sorts), & new_unittest('real_radix_sorts', test_real_radix_sorts), & new_unittest('int_sorts', test_int_sorts), & new_unittest('char_sorts', test_char_sorts), & 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('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) & ] end subroutine collect_sorting @@ -161,7 +186,7 @@ subroutine initialize_tests() end do do i=0, string_size-1 - string_decrease(string_size - 1 - i) = char_increase(i) + string_decrease(string_size - 1 - i) = string_increase(i) end do string_rand(:) = string_increase(:) @@ -173,14 +198,48 @@ subroutine initialize_tests() string_rand(index1) = string_temp end do + do i = 0, bitset_size-1 + write(bin32,'(b32.32)') i + call bitsetl_increase(i)%from_string(bin32) + end do + do i=0, bitset_size-1 + bitsetl_decrease(bitset_size-1-i) = bitsetl_increase(i) + end do + + bitsetl_rand(:) = bitsetl_increase(:) + do i=0, bitset_size-1 + call random_number( arand ) + index1 = int( floor( arand * bitset_size ), kind=int32 ) + bitsetl_temp = bitsetl_rand(i) + bitsetl_rand(i) = bitsetl_rand(index1) + bitsetl_rand(index1) = bitsetl_temp + end do + + do i = 0, bitset_size-1 + write(bin64,'(b64.64)') i + call bitset64_increase(i)%from_string(bin64) + end do + do i=0, bitset_size-1 + bitset64_decrease(bitset_size-1-i) = bitset64_increase(i) + end do + + bitset64_rand(:) = bitset64_increase(:) + do i=0, bitset_size-1 + call random_number( arand ) + index1 = int( floor( arand * bitset_size ), kind=int32 ) + bitset64_temp = bitset64_rand(i) + bitset64_rand(i) = bitset64_rand(index1) + bitset64_rand(index1) = bitset64_temp + end do + ! Create and intialize file to report the results of the sortings open( newunit=lun, file=filename, access='sequential', action='write', & form='formatted', status='replace' ) write( lun, '(a)' ) trim(compiler_version()) write( lun, * ) - write( lun, '("| Type | Elements | Array Name | Method ' // & + write( lun, '("| Type | Elements | Array Name | Method ' // & ' | Time (s) |")' ) - write( lun, '("|-------------|----------|-----------------|-----------' // & + write( lun, '("|--------------|----------|-----------------|-----------' // & '--|-----------|")' ) end subroutine initialize_tests @@ -267,7 +326,7 @@ subroutine test_int_ord_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Ord_Sort", tdiff/rate @@ -342,7 +401,7 @@ subroutine test_char_ord_sort( a, a_name, ltest ) write(*,*) 'i = ', i 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, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Ord_Sort", tdiff/rate @@ -421,7 +480,7 @@ subroutine test_string_ord_sort( a, a_name, ltest ) write(*,'(a, 2(1x,a))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Ord_Sort", tdiff/rate @@ -453,6 +512,180 @@ subroutine test_string_ord_sort( a, a_name, ltest ) end subroutine test_string_ord_sort + subroutine test_bitsetl_ord_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical:: ltest + + call test_bitsetl_ord_sort( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_ord_sort( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_ord_sort( bitsetl_rand, "Bitset Random" , ltest) + call check(error, ltest) + + end subroutine test_bitsetl_ord_sorts + + subroutine test_bitsetl_ord_sort( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call ord_sort( bitsetl_dummy, bitsetl_work ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Ord_Sort", tdiff/rate + + !reverse + bitsetl_dummy = a + call ord_sort( bitsetl_dummy, bitsetl_work, reverse = .true. ) + + call verify_bitsetl_reverse_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + bitsetl_dummy = a + call ord_sort( bitsetl_dummy, reverse = .true. ) + + call verify_bitsetl_reverse_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + end subroutine test_bitsetl_ord_sort + + subroutine test_bitset64_ord_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical:: ltest + + call test_bitset64_ord_sort( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_ord_sort( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_ord_sort( bitset64_rand, "Bitset Random" , ltest) + call check(error, ltest) + + end subroutine test_bitset64_ord_sorts + + subroutine test_bitset64_ord_sort( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call ord_sort( bitset64_dummy, bitset64_work ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Ord_Sort", tdiff/rate + + !reverse + bitset64_dummy = a + call ord_sort( bitset64_dummy, bitset64_work, reverse = .true. ) + + call verify_bitset64_reverse_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // & + "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + bitset64_dummy = a + call ord_sort( bitset64_dummy, reverse = .true. ) + + call verify_bitset64_reverse_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse ORD_SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + + end subroutine test_bitset64_ord_sort + subroutine test_int_radix_sorts(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -533,7 +766,7 @@ subroutine test_int_radix_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Radix_Sort", tdiff/rate @@ -579,7 +812,7 @@ subroutine test_real_radix_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2f12.5)') 'real_dummy(i-1:i) = ', real_dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Real |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Radix_Sort", tdiff/rate @@ -686,7 +919,7 @@ subroutine test_int_sort( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort", tdiff/rate @@ -750,7 +983,7 @@ subroutine test_char_sort( a, a_name, ltest ) write(*,*) 'i = ', i 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, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort", tdiff/rate @@ -815,7 +1048,7 @@ subroutine test_string_sort( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort", tdiff/rate @@ -834,6 +1067,146 @@ subroutine test_string_sort( a, a_name, ltest ) end subroutine test_string_sort + subroutine test_bitsetl_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitsetl_sort( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort( bitsetl_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitsetl_sorts + + subroutine test_bitsetl_sort( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call sort( bitsetl_dummy ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort", tdiff/rate + + ! reverse + bitsetl_dummy = a + call sort( bitsetl_dummy, .true.) + call verify_bitsetl_reverse_sort(bitsetl_dummy, valid, i) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + end subroutine test_bitsetl_sort + + subroutine test_bitset64_sorts(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitset64_sort( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort( bitset64_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitset64_sorts + + subroutine test_bitset64_sort( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call sort( bitset64_dummy ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort", tdiff/rate + + ! reverse + bitset64_dummy = a + call sort( bitset64_dummy, .true.) + call verify_bitset64_reverse_sort(bitset64_dummy, valid, i) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "reverse SORT did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + end subroutine test_bitset64_sort + subroutine test_int_sort_indexes(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -916,7 +1289,7 @@ subroutine test_int_sort_index( a, a_name, ltest ) write(*,*) 'i = ', i write(*,'(a18, 2i7)') 'a(index(i-1:i)) = ', a(index(i-1:i)) end if - write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & test_size, a_name, "Sort_Index", tdiff/rate @@ -985,7 +1358,7 @@ subroutine test_char_sort_index( a, a_name, ltest ) write(*,*) 'i = ', i 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, " |", ' // & + write( lun, '("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & char_size, a_name, "Sort_Index", tdiff/rate @@ -1039,12 +1412,125 @@ subroutine test_string_sort_index( a, a_name, ltest ) write(*,'(a17, 2(1x,a4))') 'string_dummy(i-1:i) = ', & string_dummy(i-1:i) end if - write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + write( lun, '("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & 'a12, " |", F10.6, " |" )' ) & string_size, a_name, "Sort_Index", tdiff/rate end subroutine test_string_sort_index + subroutine test_bitsetl_sort_indexes(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitsetl_sort_index( bitsetl_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort_index( bitsetl_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitsetl_sort_index( bitsetl_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitsetl_sort_indexes + + subroutine test_bitsetl_sort_index( a, a_name, ltest ) + type(bitset_large), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitsetl_dummy = a + call system_clock( t0, rate ) + call sort_index( bitsetl_dummy, index, bitsetl_work, iwork ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitsetl_sort( bitsetl_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT_INDEX did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitsetl_dummy(i-1)%to_string(bin_im1) + call bitsetl_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort_Index", tdiff/rate + + end subroutine test_bitsetl_sort_index + + subroutine test_bitset64_sort_indexes(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + logical :: ltest + + call test_bitset64_sort_index( bitset64_decrease, "Bitset Decrease", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort_index( bitset64_increase, "Bitset Increase", ltest ) + call check(error, ltest) + if (allocated(error)) return + + call test_bitset64_sort_index( bitset64_rand, "Bitset Random", ltest ) + call check(error, ltest) + + end subroutine test_bitset64_sort_indexes + + subroutine test_bitset64_sort_index( a, a_name, ltest ) + type(bitset_64), intent(in) :: a(0:) + character(*), intent(in) :: a_name + logical, intent(out) :: ltest + + integer(int64) :: t0, t1, tdiff + real(dp) :: rate + integer(int64) :: i + logical :: valid + character(:), allocatable :: bin_im1, bin_i + + ltest = .true. + + tdiff = 0 + do i = 1, repeat + bitset64_dummy = a + call system_clock( t0, rate ) + call sort_index( bitset64_dummy, index, bitset64_work, iwork ) + call system_clock( t1, rate ) + tdiff = tdiff + t1 - t0 + end do + tdiff = tdiff/repeat + + call verify_bitset64_sort( bitset64_dummy, valid, i ) + ltest = (ltest .and. valid) + if ( .not. valid ) then + write( *, * ) "SORT_INDEX did not sort " // a_name // "." + write(*,*) 'i = ', i + call bitset64_dummy(i-1)%to_string(bin_im1) + call bitset64_dummy(i)%to_string(bin_i) + write(*,'(a, 2(a:,1x))') 'bitset64_dummy(i-1:i) = ', & + bin_im1, bin_i + end if + write( lun, '("| Bitset_64 |", 1x, i7, 2x, "|", 1x, a15, " |", ' // & + 'a12, " |", F10.6, " |" )' ) & + bitset_size, a_name, "Sort_Index", tdiff/rate + + end subroutine test_bitset64_sort_index subroutine verify_sort( a, valid, i ) integer(int32), intent(in) :: a(0:) @@ -1094,6 +1580,38 @@ subroutine verify_string_sort( a, valid, i ) end subroutine verify_string_sort + subroutine verify_bitsetl_sort( a, valid, i ) + type(bitset_large), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) > a(i) ) return + end do + valid = .true. + + end subroutine verify_bitsetl_sort + + subroutine verify_bitset64_sort( a, valid, i ) + type(bitset_64), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) > a(i) ) return + end do + valid = .true. + + end subroutine verify_bitset64_sort + subroutine verify_char_sort( a, valid, i ) character(len=4), intent(in) :: a(0:) logical, intent(out) :: valid @@ -1174,6 +1692,37 @@ subroutine verify_string_reverse_sort( a, valid, i ) end subroutine verify_string_reverse_sort + subroutine verify_bitsetl_reverse_sort( a, valid, i ) + type(bitset_large), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) < a(i) ) return + end do + valid = .true. + + end subroutine verify_bitsetl_reverse_sort + + subroutine verify_bitset64_reverse_sort( a, valid, i ) + type(bitset_64), intent(in) :: a(0:) + logical, intent(out) :: valid + integer(int64), intent(out) :: i + + integer(int64) :: n + + n = size( a, kind=int64 ) + valid = .false. + do i=1, n-1 + if ( a(i-1) < a(i) ) return + end do + valid = .true. + + end subroutine verify_bitset64_reverse_sort end module test_sorting