From 5f79d2ecee0894a8c16120be240213c3e7a83202 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 15:51:51 +0200 Subject: [PATCH 01/11] rename sort_index to sort_adj --- ...tdlib_sorting_sort_index.fypp => stdlib_sorting_sort_adj.fypp} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{stdlib_sorting_sort_index.fypp => stdlib_sorting_sort_adj.fypp} (100%) diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_adj.fypp similarity index 100% rename from src/stdlib_sorting_sort_index.fypp rename to src/stdlib_sorting_sort_adj.fypp From 230a85c11d6f80c2bf14c5fcf6e454135364ffd3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 15:52:53 +0200 Subject: [PATCH 02/11] sort_index: call of sort_adj --- src/CMakeLists.txt | 1 + src/stdlib_sorting.fypp | 38 +++++++++++ src/stdlib_sorting_sort_adj.fypp | 8 +-- src/stdlib_sorting_sort_index.fypp | 104 +++++++++++++++++++++++++++++ 4 files changed, 147 insertions(+), 4 deletions(-) create mode 100644 src/stdlib_sorting_sort_index.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 579b70c72..3f351e976 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -38,6 +38,7 @@ set(fppFiles stdlib_sorting.fypp stdlib_sorting_ord_sort.fypp stdlib_sorting_sort.fypp + stdlib_sorting_sort_adj.fypp stdlib_sorting_sort_index.fypp stdlib_specialfunctions_gamma.fypp stdlib_stats.fypp diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index e0bb93827..3114a67a0 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -505,6 +505,44 @@ module stdlib_sorting end interface sort + + interface sort_adj +!! Version: experimental +!! +!! The generic subroutine interface implementing the `SORT_ADJ` algorithm, +!! based on the `"Rust" sort` algorithm found in `slice.rs` +!! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159 +!! but modified to return an array of indices that would provide a stable +!! sort of the rank one `ARRAY` input. +!! ([Specification](../page/specs/stdlib_sorting.html#sort_adj-creates-an-array-of-sorting-indices-for-an-input-array-while-also-sorting-the-array)) +!! +!! The indices by default correspond to a +!! 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 ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + module subroutine ${name1}$_sort_adj_${namei}$( array, index, work, iwork, & + reverse ) +!! Version: experimental +!! +!! `${name1}$_sort_adj_${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:) + ${ti}$, intent(out) :: index(0:) + ${t2}$, intent(out), optional :: work(0:) + ${ti}$, intent(out), optional :: iwork(0:) + logical, intent(in), optional :: reverse + end subroutine ${name1}$_sort_adj_${namei}$ + + #:endfor +#:endfor + + end interface sort_adj + interface sort_index !! Version: experimental !! diff --git a/src/stdlib_sorting_sort_adj.fypp b/src/stdlib_sorting_sort_adj.fypp index cc2afe9cf..21a10616b 100644 --- a/src/stdlib_sorting_sort_adj.fypp +++ b/src/stdlib_sorting_sort_adj.fypp @@ -62,7 +62,7 @@ !! of modified versions of the code in the Fortran Standard Library under !! the MIT license. -submodule(stdlib_sorting) stdlib_sorting_sort_index +submodule(stdlib_sorting) stdlib_sorting_sort_adj implicit none @@ -71,7 +71,7 @@ contains #: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_${namei}$( array, index, work, iwork, reverse ) + module subroutine ${name1}$_sort_adj_${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 @@ -494,9 +494,9 @@ contains end subroutine reverse_segment - end subroutine ${name1}$_sort_index_${namei}$ + end subroutine ${name1}$_sort_adj_${namei}$ #:endfor #:endfor -end submodule stdlib_sorting_sort_index +end submodule stdlib_sorting_sort_adj diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp new file mode 100644 index 000000000..18821be59 --- /dev/null +++ b/src/stdlib_sorting_sort_index.fypp @@ -0,0 +1,104 @@ +#:include "common.fypp" +#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS)) +#: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)) + +#: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. +#: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: +!! +!! This file is subjec† both to the Fortran Standard Library license, and +!! to additional licensing requirements as it contains translations of +!! other software. +!! +!! The Fortran Standard Library, including this file, is distributed under +!! the MIT license that should be included with the library's distribution. +!! +!! Copyright (c) 2021 Fortran stdlib developers +!! +!! Permission is hereby granted, free of charge, to any person obtaining a +!! copy of this software and associated documentation files (the +!! "Software"), to deal in the Software without restriction, including +!! without limitation the rights to use, copy, modify, merge, publish, +!! distribute, sublicense, and/or sellcopies of the Software, and to permit +!! persons to whom the Software is furnished to do so, subject to the +!! following conditions: +!! +!! The above copyright notice and this permission notice shall be included +!! in all copies or substantial portions of the Software. +!! +!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +!! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +!! CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +!! TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +!! SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +!! +!! The generic subroutine, `SORT_INDEX`, is substantially a translation to +!! Fortran 2008 of the `"Rust" sort` sorting routines in +!! [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs) +!! The `rust sort` implementation is distributed with the header: +!! +!! Copyright 2012-2015 The Rust Project Developers. See the COPYRIGHT +!! file at the top-level directory of this distribution and at +!! http://rust-lang.org/COPYRIGHT. +!! +!! Licensed under the Apache License, Version 2.0 or the MIT license +!! , at your +!! option. This file may not be copied, modified, or distributed +!! except according to those terms. +!! +!! so the license for the original`slice.rs` code is compatible with the use +!! of modified versions of the code in the Fortran Standard Library under +!! the MIT license. + +submodule(stdlib_sorting) stdlib_sorting_sort_index + + implicit none + +contains + +#: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_${namei}$( array, index, work, iwork, reverse ) + ${t1}$, intent(inout) :: array(0:) + ${ti}$, intent(out) :: index(0:) + ${t3}$, intent(out), optional :: work(0:) + ${ti}$, intent(out), optional :: iwork(0:) + logical, intent(in), optional :: reverse + + integer(int_index) :: array_size, i, stat + + array_size = size(array, kind=int_index) + + if ( array_size > huge(index)) then + error stop "Too many entries for the kind of index." + end if + + if ( array_size > size(index, kind=int_index) ) then + error stop "Too many entries for the size of index." + end if + + do i = 0, array_size-1 + index(i) = int(i+1, kind=${ki}$) + end do + + call sort_adj(array, index, work, iwork, reverse) + + end subroutine ${name1}$_sort_index_${namei}$ + + #:endfor +#:endfor + +end submodule stdlib_sorting_sort_index From 52302340bd200779aa5230b437b296560d88033f Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 16:39:46 +0200 Subject: [PATCH 03/11] call of sort_adj in sort_index --- src/CMakeLists.txt | 1 - src/stdlib_sorting.fypp | 58 +++++++++++++--- src/stdlib_sorting_sort_adj.fypp | 15 ++--- src/stdlib_sorting_sort_index.fypp | 104 ----------------------------- 4 files changed, 54 insertions(+), 124 deletions(-) delete mode 100644 src/stdlib_sorting_sort_index.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3f351e976..8c2714f43 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -39,7 +39,6 @@ set(fppFiles stdlib_sorting_ord_sort.fypp stdlib_sorting_sort.fypp stdlib_sorting_sort_adj.fypp - stdlib_sorting_sort_index.fypp stdlib_specialfunctions_gamma.fypp stdlib_stats.fypp stdlib_stats_corr.fypp diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 3114a67a0..c47c41dad 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -13,6 +13,9 @@ #! This approach allows us to have the same code for all input types. #: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 IRC_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME + + !! Licensing: !! @@ -520,23 +523,23 @@ 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 ki, ti, namei in INT_INDEX_TYPES_ALT_NAME +#:for ki, ti, namei in IRC_INDEX_TYPES_ALT_NAME #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_sort_adj_${namei}$( array, index, work, iwork, & + module subroutine ${name1}$_${namei}$_sort_adj( array, index, work, iwork, & reverse ) !! Version: experimental !! -!! `${name1}$_sort_adj_${namei}$( array, index[, work, iwork, reverse] )` sorts +!! `${name1}$_${namei}$_sort_adj( 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:) - ${ti}$, intent(out) :: index(0:) + ${ti}$, intent(inout) :: index(0:) ${t2}$, intent(out), optional :: work(0:) - ${ti}$, intent(out), optional :: iwork(0:) + ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - end subroutine ${name1}$_sort_adj_${namei}$ + end subroutine ${name1}$_${namei}$_sort_adj #:endfor #:endfor @@ -559,7 +562,24 @@ module stdlib_sorting #: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, & +!> Version: experimental +!> +!> `${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. + module procedure ${name1}$_sort_index_${namei}$ + #:endfor +#:endfor + + end interface sort_index + +contains + +#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME + #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, & reverse ) !! Version: experimental !! @@ -573,12 +593,32 @@ module stdlib_sorting ${t2}$, intent(out), optional :: work(0:) ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse + + + integer(int_index) :: array_size, i + + array_size = size(array, kind=int_index) + + if ( array_size > huge(index)) then + error stop "Too many entries for the kind of index." + end if + + if ( array_size > size(index, kind=int_index) ) then + error stop "Too many entries for the size of index." + end if + + do i = 0, array_size-1 + index(i) = int(i+1, kind=${ki}$) + end do + + call sort_adj(array, index, work, iwork, reverse) + + + end subroutine ${name1}$_sort_index_${namei}$ #:endfor #:endfor - end interface sort_index - end module stdlib_sorting diff --git a/src/stdlib_sorting_sort_adj.fypp b/src/stdlib_sorting_sort_adj.fypp index 21a10616b..180ccd889 100644 --- a/src/stdlib_sorting_sort_adj.fypp +++ b/src/stdlib_sorting_sort_adj.fypp @@ -5,13 +5,12 @@ #: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. #: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 IRC_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME !! Licensing: !! @@ -68,10 +67,10 @@ submodule(stdlib_sorting) stdlib_sorting_sort_adj contains -#:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME +#:for ki, ti, tii, namei in IRC_INDEX_TYPES_ALT_NAME #:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_sort_adj_${namei}$( array, index, work, iwork, reverse ) + module subroutine ${name1}$_${namei}$_sort_adj( 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 @@ -98,7 +97,7 @@ contains ! used as scratch memory. ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(out) :: index(0:) + ${ti}$, intent(inout) :: index(0:) ${t3}$, intent(out), optional :: work(0:) ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse @@ -117,10 +116,6 @@ contains error stop "Too many entries for the size of index." end if - do i = 0, array_size-1 - index(i) = int(i+1, kind=${ki}$) - end do - if ( optval(reverse, .false.) ) then call reverse_segment( array, index ) end if @@ -494,7 +489,7 @@ contains end subroutine reverse_segment - end subroutine ${name1}$_sort_adj_${namei}$ + end subroutine ${name1}$_${namei}$_sort_adj #:endfor #:endfor diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp deleted file mode 100644 index 18821be59..000000000 --- a/src/stdlib_sorting_sort_index.fypp +++ /dev/null @@ -1,104 +0,0 @@ -#:include "common.fypp" -#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS)) -#: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)) - -#: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. -#: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: -!! -!! This file is subjec† both to the Fortran Standard Library license, and -!! to additional licensing requirements as it contains translations of -!! other software. -!! -!! The Fortran Standard Library, including this file, is distributed under -!! the MIT license that should be included with the library's distribution. -!! -!! Copyright (c) 2021 Fortran stdlib developers -!! -!! Permission is hereby granted, free of charge, to any person obtaining a -!! copy of this software and associated documentation files (the -!! "Software"), to deal in the Software without restriction, including -!! without limitation the rights to use, copy, modify, merge, publish, -!! distribute, sublicense, and/or sellcopies of the Software, and to permit -!! persons to whom the Software is furnished to do so, subject to the -!! following conditions: -!! -!! The above copyright notice and this permission notice shall be included -!! in all copies or substantial portions of the Software. -!! -!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -!! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -!! CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -!! TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -!! SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -!! -!! The generic subroutine, `SORT_INDEX`, is substantially a translation to -!! Fortran 2008 of the `"Rust" sort` sorting routines in -!! [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs) -!! The `rust sort` implementation is distributed with the header: -!! -!! Copyright 2012-2015 The Rust Project Developers. See the COPYRIGHT -!! file at the top-level directory of this distribution and at -!! http://rust-lang.org/COPYRIGHT. -!! -!! Licensed under the Apache License, Version 2.0 or the MIT license -!! , at your -!! option. This file may not be copied, modified, or distributed -!! except according to those terms. -!! -!! so the license for the original`slice.rs` code is compatible with the use -!! of modified versions of the code in the Fortran Standard Library under -!! the MIT license. - -submodule(stdlib_sorting) stdlib_sorting_sort_index - - implicit none - -contains - -#: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_${namei}$( array, index, work, iwork, reverse ) - ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(out) :: index(0:) - ${t3}$, intent(out), optional :: work(0:) - ${ti}$, intent(out), optional :: iwork(0:) - logical, intent(in), optional :: reverse - - integer(int_index) :: array_size, i, stat - - array_size = size(array, kind=int_index) - - if ( array_size > huge(index)) then - error stop "Too many entries for the kind of index." - end if - - if ( array_size > size(index, kind=int_index) ) then - error stop "Too many entries for the size of index." - end if - - do i = 0, array_size-1 - index(i) = int(i+1, kind=${ki}$) - end do - - call sort_adj(array, index, work, iwork, reverse) - - end subroutine ${name1}$_sort_index_${namei}$ - - #:endfor -#:endfor - -end submodule stdlib_sorting_sort_index From 962bcc46204624d15c6dcf9a620c65f82cc6c6c4 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 16:50:51 +0200 Subject: [PATCH 04/11] cleaning --- src/stdlib_sorting.fypp | 4 ++-- src/stdlib_sorting_sort_adj.fypp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index c47c41dad..fd2d4203f 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -13,7 +13,7 @@ #! This approach allows us to have the same code for all input types. #: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 IRC_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME +#:set IR_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME @@ -523,7 +523,7 @@ 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 ki, ti, namei in IRC_INDEX_TYPES_ALT_NAME +#:for ti, tii, namei in IR_INDEX_TYPES_ALT_NAME #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_${namei}$_sort_adj( array, index, work, iwork, & reverse ) diff --git a/src/stdlib_sorting_sort_adj.fypp b/src/stdlib_sorting_sort_adj.fypp index 180ccd889..e397b32f8 100644 --- a/src/stdlib_sorting_sort_adj.fypp +++ b/src/stdlib_sorting_sort_adj.fypp @@ -10,7 +10,7 @@ #! This approach allows us to have the same code for all input types. #: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 IRC_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME +#:set IR_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME !! Licensing: !! @@ -67,7 +67,7 @@ submodule(stdlib_sorting) stdlib_sorting_sort_adj contains -#:for ki, ti, tii, namei in IRC_INDEX_TYPES_ALT_NAME +#:for ki, ti, tii, namei in IR_INDEX_TYPES_ALT_NAME #:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME module subroutine ${name1}$_${namei}$_sort_adj( array, index, work, iwork, reverse ) From 3cf4711cca3e476ed0e9df7e7fdf0abe9ae073c3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 21:05:14 +0200 Subject: [PATCH 05/11] addition of specs and of example --- doc/specs/stdlib_sorting.md | 105 ++++++++++++++++++++++++++- example/sorting/CMakeLists.txt | 1 + example/sorting/example_sort_adj.f90 | 15 ++++ src/stdlib_sorting.fypp | 70 ++++++++++++++++++ src/stdlib_sorting_ord_sort.fypp | 2 + src/stdlib_sorting_sort_adj.fypp | 8 +- 6 files changed, 195 insertions(+), 6 deletions(-) create mode 100644 example/sorting/example_sort_adj.f90 diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index 3a44d84f8..a58e0c0a9 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -46,6 +46,9 @@ data: * `ORD_SORT` is intended to sort simple arrays of intrinsic data that have significant sections that were partially ordered before the sort; +* `SORT_ADJ` is based on `ORD_SORT`, but in addition to sorting the + input array, it returns a related array re-ordered in the + same way; * `SORT_INDEX` is based on `ORD_SORT`, but in addition to sorting the input array, it returns indices that map the original array to its sorted version. This enables related arrays to be re-ordered in the @@ -60,10 +63,10 @@ data: The Fortran Standard Library is distributed under the MIT License. However components of the library may be based on code with additional licensing restrictions. In particular `ORD_SORT`, -`SORT_INDEX`, and `SORT` are translations of codes with their +`SORT_ADJ`, `SORT_INDEX`, and `SORT` are translations of codes with their own distribution restrictions. -The `ORD_SORT` and `SORT_INDEX` subroutines are essentially +The `ORD_SORT`, `SORT_ADJ` and `SORT_INDEX` subroutines are essentially translations to Fortran 2008 of the `"Rust" sort` of the Rust Language distributed as part of [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs). @@ -140,6 +143,24 @@ argument or allocated internally on the stack. Arrays can be also sorted in a decreasing order by providing the argument `reverse = .true.`. +#### The `SORT_ADJ` subroutine + +The `SORT` and `ORD_SORT` subroutines can sort rank 1 isolated +arrays of intrinsic types, but do nothing for the coordinated sorting +of related data, e.g., a related rank 1 array. Therefore the module +provides a subroutine, `SORT_ADJ`, that re-order such a rank 1 array +in the same way as the input array based on the `ORD_SORT` algorithm, +in addition to sorting the input array. + +The logic of `SORT_ADJ` parallels that of `ORD_SORT`, with +additional housekeeping to keep the associated array consistent with +the sorted positions of the input array. Because of this additional +housekeeping it has slower runtime performance than `ORD_SORT`. +`SORT_ADJ` requires the use of two "scratch" arrays, that may be +provided as optional `work` and `iwork` arguments or allocated +internally on the stack. + + #### The `SORT_INDEX` subroutine The `SORT` and `ORD_SORT` subroutines can sort rank 1 isolated @@ -198,7 +219,7 @@ factor of six. Still, even when it shows enhanced performance, its performance on partially sorted data is typically an order of magnitude slower than `ORD_SORT`. Its memory requirements are also low, being of order O(Ln(N)), while the memory requirements of -`ORD_SORT` and `SORT_INDEX` are of order O(N). +`ORD_SORT`, `SORT_ADJ` and `SORT_INDEX` are of order O(N). #### The `RADIX_SORT` subroutine @@ -385,6 +406,84 @@ element of `array` is a `NaN`. {!example/sorting/example_radix_sort.f90!} ``` +#### `sort_adj` - sorts an associated array in the same way as the input array, while also sorting the array. + +##### Status + +Experimental + +##### Description + +Returns the input `array` sorted in the direction requested while +retaining order stability, and an associated array whose elements are +sorted in the same way as the input `array`. + +##### Syntax + +`call ` [[stdlib_sorting(module):sort_adj(interface)]] `( array, index[, work, iwork, reverse ] )` + +##### Class + +Generic subroutine. + +##### Arguments + +`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(*)`, `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. + +`index`: shall be a rank one `integer` or `real` array of +the size of `array`. It is an `intent(inout)` argument. On return it +shall have values that are the indices needed to sort the original +array in the desired direction. + +`work` (optional): shall be a rank one array of any of the same type as +`array`, 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 +requirements for the code. Its contents on return are undefined. + +`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 +requirements for the code. Its contents on return are undefined. + +`reverse` (optional): shall be a scalar of type default logical. It +is an `intent(in)` argument. If present with a value of `.true.` then +`array` will be sorted in order of non-increasing values in stable +order. Otherwise `array` will be sorted in order of non-decreasing +values in stable order. + +##### Notes + +`SORT_ADJ` implements the hybrid sorting algorithm of `ORD_SORT`, +keeping the values of `index` consistent with the elements of `array` +as it is sorted. As a `merge sort` based algorithm, it is a stable +sorting comparison algorithm. The optional `work` and `iwork` arrays +replace "scratch" memory that would otherwise be allocated on the +stack. If `array` is of any kind of `REAL` the order of the elements in +`index` and `array` on return are undefined if any element of `array` +is a `NaN`. Sorting of `CHARACTER(*)` and `STRING_TYPE` arrays are +based on the operator `>`, and not on the function `LGT`. + +It should be emphasized that the order of `array` will typically be +different on return + +##### Examples + +Sorting a rank one array with `sort_adj`: + +```Fortran +{!example/sorting/example_sort_adj.f90!} +``` + #### `sort_index` - creates an array of sorting indices for an input array, while also sorting the array. ##### Status diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 4628ce20c..46cd530f9 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,5 +1,6 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) +ADD_EXAMPLE(sort_adj) ADD_EXAMPLE(sort_index) ADD_EXAMPLE(radix_sort) ADD_EXAMPLE(sort_bitset) diff --git a/example/sorting/example_sort_adj.f90 b/example/sorting/example_sort_adj.f90 new file mode 100644 index 000000000..20b3c004c --- /dev/null +++ b/example/sorting/example_sort_adj.f90 @@ -0,0 +1,15 @@ +program example_sort_adj + use stdlib_sorting, only: sort_adj + implicit none + integer, allocatable :: array(:) + real, allocatable :: adj(:) + + array = [5, 4, 3, 1, 10, 4, 9] + allocate(adj, source=real(array)) + + call sort_adj(array, adj) + + print *, array !print [1, 3, 4, 4, 5, 9, 10] + print *, adj !print [1., 3., 4., 4., 5., 9., 10.] + +end program example_sort_adj diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index fd2d4203f..7f7478128 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -295,6 +295,76 @@ module stdlib_sorting !! ! Sort the random data !! call radix_sort( array ) !! ... +!!``` + + public sort_adj +!! Version: experimental +!! +!! The generic subroutine implementing the `SORT_ADJ` algorithm to +!! return an index array whose elements are sorted in the same order +!! as the input array in the +!! desired direction. It is primarily intended to be used to sort a +!! rank 1 `integer` or `real` array based on the values of a component of the array. +!! Its use has the syntax: +!! +!! call sort_adj( array, index[, work, iwork, reverse ] ) +!! +!! with the arguments: +!! +!! * 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)`, +!! `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. +!! +!! * index: a rank 1 `integer` or `real` array. It is an `intent(inout)` +!! argument of the type `integer(int_index)`. Its size shall be the +!! same as `array`. On return, its elements are sorted in the same order +!! as the input `array` in the direction specified by `reverse`. +!! +!! * work (optional): shall be a rank 1 array of the same type as +!! `array`, and shall have at least `size(array)/2` elements. It is an +!! `intent(out)` argument 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 requirements +!! for the code. Its value on return is undefined. +!! +!! * iwork (optional): shall be a rank 1 integer array of the same type as `index`, +!! and shall have at least `size(array)/2` elements. It is an +!! `intent(out)` argument 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 requirements +!! for the code. Its value on return is undefined. +!! +!! * `reverse` (optional): shall be a scalar of type default logical. It +!! is an `intent(in)` argument. If present with a value of `.true.` then +!! `array` will be sorted in order of non-increasing values in stable +!! order. Otherwise `array` will be sorted in order of non-decreasing +!! values in stable order. +!! +!!#### Examples +!! +!! Sorting a related rank one array: +!! +!!```Fortran +!!program example_sort_adj +!! use stdlib_sorting, only: sort_adj +!! implicit none +!! integer, allocatable :: array(:) +!! real, allocatable :: adj(:) +!! +!! array = [5, 4, 3, 1, 10, 4, 9] +!! allocate(adj, source=real(array)) +!! +!! call sort_adj(array, adj) +!! +!! print *, array !print [1, 3, 4, 4, 5, 9, 10] +!! print *, adj !print [1., 3., 4., 4., 5., 9., 10.] +!! +!!end program example_sort_adj !!``` public sort_index diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index b96ea295a..c77e1c797 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -117,6 +117,8 @@ contains integer :: stat array_size = size( array, kind=int_index ) + +! If necessary allocate buffers to serve as scratch memory. if ( present(work) ) then if ( size(work, kind=int_index) < array_size/2 ) then error stop "${name1}$_${sname}$_ord_sort: work array is too small." diff --git a/src/stdlib_sorting_sort_adj.fypp b/src/stdlib_sorting_sort_adj.fypp index e397b32f8..e5afc01e0 100644 --- a/src/stdlib_sorting_sort_adj.fypp +++ b/src/stdlib_sorting_sort_adj.fypp @@ -42,7 +42,7 @@ !! TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE !! SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. !! -!! The generic subroutine, `SORT_INDEX`, is substantially a translation to +!! The generic subroutine, `SORT_ADJ`, is substantially a translation to !! Fortran 2008 of the `"Rust" sort` sorting routines in !! [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs) !! The `rust sort` implementation is distributed with the header: @@ -95,7 +95,6 @@ contains ! estimation of the optimal `run size` as suggested in Tim Peters' ! original `listsort.txt`, and the optional `work` and `iwork` arrays to be ! used as scratch memory. - ${t1}$, intent(inout) :: array(0:) ${ti}$, intent(inout) :: index(0:) ${t3}$, intent(out), optional :: work(0:) @@ -104,7 +103,8 @@ contains ${t2}$, allocatable :: buf(:) ${ti}$, allocatable :: ibuf(:) - integer(int_index) :: array_size, i, stat + integer(int_index) :: array_size, i + integer(int_index) :: stat array_size = size(array, kind=int_index) @@ -136,6 +136,7 @@ contains call merge_sort( array, index, work, ibuf ) end if else +! Allocate a buffer to use as scratch memory. #:if t1[0:4] == "char" allocate( ${t3}$ :: buf(0:array_size/2-1), & stat=stat ) @@ -495,3 +496,4 @@ contains #:endfor end submodule stdlib_sorting_sort_adj + From 01faf83984a6b026ad7b707066eba95d9a552ef3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 15:58:10 -0400 Subject: [PATCH 06/11] Apply suggestions from code review --- doc/specs/stdlib_sorting.md | 1 - src/stdlib_sorting.fypp | 6 ------ 2 files changed, 7 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index a58e0c0a9..35cb6a55f 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -160,7 +160,6 @@ housekeeping it has slower runtime performance than `ORD_SORT`. provided as optional `work` and `iwork` arguments or allocated internally on the stack. - #### The `SORT_INDEX` subroutine The `SORT` and `ORD_SORT` subroutines can sort rank 1 isolated diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 7f7478128..0dd385459 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -15,8 +15,6 @@ & + BITSET_TYPES_ALT_NAME #:set IR_INDEX_TYPES_ALT_NAME = INT_TYPES_ALT_NAME + REAL_TYPES_ALT_NAME - - !! Licensing: !! !! This file is subject both to the Fortran Standard Library license, and @@ -578,7 +576,6 @@ module stdlib_sorting end interface sort - interface sort_adj !! Version: experimental !! @@ -664,7 +661,6 @@ contains ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - integer(int_index) :: array_size, i array_size = size(array, kind=int_index) @@ -683,8 +679,6 @@ contains call sort_adj(array, index, work, iwork, reverse) - - end subroutine ${name1}$_sort_index_${namei}$ #:endfor From 28b6f719a5eaa9d815c7b801ed13a46f300247ef Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 9 Jul 2024 22:00:41 +0200 Subject: [PATCH 07/11] some formatting --- src/stdlib_sorting.fypp | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 0dd385459..a078bfc2e 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -661,23 +661,23 @@ contains ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - integer(int_index) :: array_size, i + integer(int_index) :: array_size, i - array_size = size(array, kind=int_index) + array_size = size(array, kind=int_index) - if ( array_size > huge(index)) then - error stop "Too many entries for the kind of index." - end if + if ( array_size > huge(index)) then + error stop "Too many entries for the kind of index." + end if - if ( array_size > size(index, kind=int_index) ) then - error stop "Too many entries for the size of index." - end if + if ( array_size > size(index, kind=int_index) ) then + error stop "Too many entries for the size of index." + end if - do i = 0, array_size-1 - index(i) = int(i+1, kind=${ki}$) - end do + do i = 0, array_size-1 + index(i) = int(i+1, kind=${ki}$) + end do - call sort_adj(array, index, work, iwork, reverse) + call sort_adj(array, index, work, iwork, reverse) end subroutine ${name1}$_sort_index_${namei}$ From b1e51da3b9ac030785dff06a30789d9f91f3b04e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 10 Jul 2024 21:02:33 +0200 Subject: [PATCH 08/11] rename adj and index to adjoint --- example/sorting/CMakeLists.txt | 2 +- example/sorting/example_sort_adj.f90 | 15 --- example/sorting/example_sort_adjoint.f90 | 15 +++ src/CMakeLists.txt | 2 +- src/stdlib_sorting.fypp | 38 +++---- ....fypp => stdlib_sorting_sort_adjoint.fypp} | 100 +++++++++--------- 6 files changed, 86 insertions(+), 86 deletions(-) delete mode 100644 example/sorting/example_sort_adj.f90 create mode 100644 example/sorting/example_sort_adjoint.f90 rename src/{stdlib_sorting_sort_adj.fypp => stdlib_sorting_sort_adjoint.fypp} (85%) diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 46cd530f9..6d64ea2f1 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -1,6 +1,6 @@ ADD_EXAMPLE(ord_sort) ADD_EXAMPLE(sort) -ADD_EXAMPLE(sort_adj) +ADD_EXAMPLE(sort_adjoint) ADD_EXAMPLE(sort_index) ADD_EXAMPLE(radix_sort) ADD_EXAMPLE(sort_bitset) diff --git a/example/sorting/example_sort_adj.f90 b/example/sorting/example_sort_adj.f90 deleted file mode 100644 index 20b3c004c..000000000 --- a/example/sorting/example_sort_adj.f90 +++ /dev/null @@ -1,15 +0,0 @@ -program example_sort_adj - use stdlib_sorting, only: sort_adj - implicit none - integer, allocatable :: array(:) - real, allocatable :: adj(:) - - array = [5, 4, 3, 1, 10, 4, 9] - allocate(adj, source=real(array)) - - call sort_adj(array, adj) - - print *, array !print [1, 3, 4, 4, 5, 9, 10] - print *, adj !print [1., 3., 4., 4., 5., 9., 10.] - -end program example_sort_adj diff --git a/example/sorting/example_sort_adjoint.f90 b/example/sorting/example_sort_adjoint.f90 new file mode 100644 index 000000000..d311fea4e --- /dev/null +++ b/example/sorting/example_sort_adjoint.f90 @@ -0,0 +1,15 @@ +program example_sort_adjoint + use stdlib_sorting, only: sort_adjoint + implicit none + integer, allocatable :: array(:) + real, allocatable :: adjoint(:) + + array = [5, 4, 3, 1, 10, 4, 9] + allocate(adjoint, source=real(array)) + + call sort_adjoint(array, adjoint) + + print *, array !print [1, 3, 4, 4, 5, 9, 10] + print *, adjoint !print [1., 3., 4., 4., 5., 9., 10.] + +end program example_sort_adjoint diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8c2714f43..5b92b7eff 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -38,7 +38,7 @@ set(fppFiles stdlib_sorting.fypp stdlib_sorting_ord_sort.fypp stdlib_sorting_sort.fypp - stdlib_sorting_sort_adj.fypp + stdlib_sorting_sort_adjoint.fypp stdlib_specialfunctions_gamma.fypp stdlib_stats.fypp stdlib_stats_corr.fypp diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index a078bfc2e..c675e5f3f 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -295,17 +295,17 @@ module stdlib_sorting !! ... !!``` - public sort_adj + public sort_adjoint !! Version: experimental !! !! The generic subroutine implementing the `SORT_ADJ` algorithm to -!! return an index array whose elements are sorted in the same order +!! return an adjoint array whose elements are sorted in the same order !! as the input array in the !! desired direction. It is primarily intended to be used to sort a !! rank 1 `integer` or `real` array based on the values of a component of the array. !! Its use has the syntax: !! -!! call sort_adj( array, index[, work, iwork, reverse ] ) +!! call sort_adjoint( array, adjoint_array[, work, iwork, reverse ] ) !! !! with the arguments: !! @@ -315,11 +315,11 @@ module stdlib_sorting !! `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. +!! then the ordering of the `array` and `adjoint_array` results is undefined. !! Otherwise it is defined to be as specified by reverse. !! -!! * index: a rank 1 `integer` or `real` array. It is an `intent(inout)` -!! argument of the type `integer(int_index)`. Its size shall be the +!! * adjoint_array: a rank 1 `integer` or `real` array. It is an `intent(inout)` +!! argument. Its size shall be the !! same as `array`. On return, its elements are sorted in the same order !! as the input `array` in the direction specified by `reverse`. !! @@ -330,7 +330,7 @@ module stdlib_sorting !! storage, its use can significantly reduce the stack memory requirements !! for the code. Its value on return is undefined. !! -!! * iwork (optional): shall be a rank 1 integer array of the same type as `index`, +!! * iwork (optional): shall be a rank 1 integer array of the same type as `adjoint_array`, !! and shall have at least `size(array)/2` elements. It is an !! `intent(out)` argument to be used as "scratch" memory !! for internal record keeping. If associated with an array in static @@ -348,8 +348,8 @@ module stdlib_sorting !! Sorting a related rank one array: !! !!```Fortran -!!program example_sort_adj -!! use stdlib_sorting, only: sort_adj +!!program example_sort_adjoint +!! use stdlib_sorting, only: sort_adjoint !! implicit none !! integer, allocatable :: array(:) !! real, allocatable :: adj(:) @@ -357,12 +357,12 @@ module stdlib_sorting !! array = [5, 4, 3, 1, 10, 4, 9] !! allocate(adj, source=real(array)) !! -!! call sort_adj(array, adj) +!! call sort_adjoint(array, adj) !! !! print *, array !print [1, 3, 4, 4, 5, 9, 10] !! print *, adj !print [1., 3., 4., 4., 5., 9., 10.] !! -!!end program example_sort_adj +!!end program example_sort_adjoint !!``` public sort_index @@ -576,7 +576,7 @@ module stdlib_sorting end interface sort - interface sort_adj + interface sort_adjoint !! Version: experimental !! !! The generic subroutine interface implementing the `SORT_ADJ` algorithm, @@ -584,7 +584,7 @@ module stdlib_sorting !! https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs#L2159 !! but modified to return an array of indices that would provide a stable !! sort of the rank one `ARRAY` input. -!! ([Specification](../page/specs/stdlib_sorting.html#sort_adj-creates-an-array-of-sorting-indices-for-an-input-array-while-also-sorting-the-array)) +!! ([Specification](../page/specs/stdlib_sorting.html#sort_adjoint-creates-an-array-of-sorting-indices-for-an-input-array-while-also-sorting-the-array)) !! !! The indices by default correspond to a !! non-decreasing sort, but if the optional argument `REVERSE` is present @@ -592,26 +592,26 @@ module stdlib_sorting #:for ti, tii, namei in IR_INDEX_TYPES_ALT_NAME #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_${namei}$_sort_adj( array, index, work, iwork, & + module subroutine ${name1}$_${namei}$_sort_adjoint( array, adjoint_array, work, iwork, & reverse ) !! Version: experimental !! -!! `${name1}$_${namei}$_sort_adj( array, index[, work, iwork, reverse] )` sorts +!! `${name1}$_${namei}$_sort_adjoint( array, adjoint_array[, 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:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${t2}$, intent(out), optional :: work(0:) ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - end subroutine ${name1}$_${namei}$_sort_adj + end subroutine ${name1}$_${namei}$_sort_adjoint #:endfor #:endfor - end interface sort_adj + end interface sort_adjoint interface sort_index !! Version: experimental @@ -677,7 +677,7 @@ contains index(i) = int(i+1, kind=${ki}$) end do - call sort_adj(array, index, work, iwork, reverse) + call sort_adjoint(array, index, work, iwork, reverse) end subroutine ${name1}$_sort_index_${namei}$ diff --git a/src/stdlib_sorting_sort_adj.fypp b/src/stdlib_sorting_sort_adjoint.fypp similarity index 85% rename from src/stdlib_sorting_sort_adj.fypp rename to src/stdlib_sorting_sort_adjoint.fypp index e5afc01e0..a1cfebc32 100644 --- a/src/stdlib_sorting_sort_adj.fypp +++ b/src/stdlib_sorting_sort_adjoint.fypp @@ -61,7 +61,7 @@ !! of modified versions of the code in the Fortran Standard Library under !! the MIT license. -submodule(stdlib_sorting) stdlib_sorting_sort_adj +submodule(stdlib_sorting) stdlib_sorting_sort_adjoint implicit none @@ -70,7 +70,7 @@ contains #:for ki, ti, tii, namei in IR_INDEX_TYPES_ALT_NAME #:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME - module subroutine ${name1}$_${namei}$_sort_adj( array, index, work, iwork, reverse ) + module subroutine ${name1}$_${namei}$_sort_adjoint( array, adjoint_array, 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 @@ -96,7 +96,7 @@ contains ! original `listsort.txt`, and the optional `work` and `iwork` arrays to be ! used as scratch memory. ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${t3}$, intent(out), optional :: work(0:) ${ti}$, intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse @@ -108,16 +108,16 @@ contains array_size = size(array, kind=int_index) - if ( array_size > huge(index)) then - error stop "Too many entries for the kind of index." + if ( array_size > huge(adjoint_array)) then + error stop "Too many entries for the kind of adjoint_array." end if - if ( array_size > size(index, kind=int_index) ) then - error stop "Too many entries for the size of index." + if ( array_size > size(adjoint_array, kind=int_index) ) then + error stop "Too many entries for the size of adjoint_array." end if if ( optval(reverse, .false.) ) then - call reverse_segment( array, index ) + call reverse_segment( array, adjoint_array ) end if ! If necessary allocate buffers to serve as scratch memory. @@ -129,11 +129,11 @@ contains if ( size(iwork, kind=int_index) < array_size/2 ) then error stop "iwork array is too small." endif - call merge_sort( array, index, work, iwork ) + call merge_sort( array, adjoint_array, work, iwork ) else allocate( ibuf(0:array_size/2-1), stat=stat ) - if ( stat /= 0 ) error stop "Allocation of index buffer failed." - call merge_sort( array, index, work, ibuf ) + if ( stat /= 0 ) error stop "Allocation of adjoint_array buffer failed." + call merge_sort( array, adjoint_array, work, ibuf ) end if else ! Allocate a buffer to use as scratch memory. @@ -148,16 +148,16 @@ contains if ( size(iwork, kind=int_index) < array_size/2 ) then error stop "iwork array is too small." endif - call merge_sort( array, index, buf, iwork ) + call merge_sort( array, adjoint_array, buf, iwork ) else allocate( ibuf(0:array_size/2-1), stat=stat ) - if ( stat /= 0 ) error stop "Allocation of index buffer failed." - call merge_sort( array, index, buf, ibuf ) + if ( stat /= 0 ) error stop "Allocation of adjoint_array buffer failed." + call merge_sort( array, adjoint_array, buf, ibuf ) end if end if if ( optval(reverse, .false.) ) then - call reverse_segment( array, index ) + call reverse_segment( array, adjoint_array ) end if contains @@ -183,28 +183,28 @@ contains end function calc_min_run - pure subroutine insertion_sort( array, index ) + pure subroutine insertion_sort( array, adjoint_array ) ! 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:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) integer(int_index) :: i, j - ${ti}$ :: key_index + ${ti}$ :: key_adjoint_array ${t3}$ :: key do j=1, size(array, kind=int_index)-1 key = array(j) - key_index = index(j) + key_adjoint_array = adjoint_array(j) i = j - 1 do while( i >= 0 ) if ( array(i) <= key ) exit array(i+1) = array(i) - index(i+1) = index(i) + adjoint_array(i+1) = adjoint_array(i) i = i - 1 end do array(i+1) = key - index(i+1) = key_index + adjoint_array(i+1) = key_adjoint_array end do end subroutine insertion_sort @@ -261,36 +261,36 @@ contains end function collapse - pure subroutine insert_head( array, index ) + pure subroutine insert_head( array, adjoint_array ) ! Inserts `array(0)` into the pre-sorted sequence `array(1:)` so that the ! whole `array(0:)` becomes sorted, copying the first element into ! a temporary variable, iterating until the right place for it is found. ! copying every traversed element into the slot preceding it, and finally, ! copying data from the temporary variable into the resulting hole. -! Consistency of the indices in `index` with the elements of `array` +! Consistency of the indices in `adjoint_array` with the elements of `array` ! are maintained. ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${t3}$ :: tmp integer(int_index) :: i - ${ti}$ :: tmp_index + ${ti}$ :: tmp_adjoint_array tmp = array(0) - tmp_index = index(0) + tmp_adjoint_array = adjoint_array(0) find_hole: do i=1, size(array, kind=int_index)-1 if ( array(i) >= tmp ) exit find_hole array(i-1) = array(i) - index(i-1) = index(i) + adjoint_array(i-1) = adjoint_array(i) end do find_hole array(i-1) = tmp - index(i-1) = tmp_index + adjoint_array(i-1) = tmp_adjoint_array end subroutine insert_head - subroutine merge_sort( array, index, buf, ibuf ) + subroutine merge_sort( array, adjoint_array, buf, ibuf ) ! The Rust merge sort borrows some (but not all) of the ideas from TimSort, ! which is described in detail at ! (http://svn.python.org/projects/python/trunk/Objects/listsort.txt). @@ -308,11 +308,11 @@ contains ! runs(i - 1)%len + runs(i)%len` ! ! The invariants ensure that the total running time is `O(n log n)` -! worst-case. Consistency of the indices in `index` with the elements of +! worst-case. Consistency of the indices in `adjoint_array` with the elements of ! `array` are maintained. ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${t3}$, intent(inout) :: buf(0:) ${ti}$, intent(inout) :: ibuf(0:) @@ -327,7 +327,7 @@ contains min_run = calc_min_run( array_size ) if ( array_size <= min_run ) then - if ( array_size >= 2 ) call insertion_sort( array, index ) + if ( array_size >= 2 ) call insertion_sort( array, adjoint_array ) return end if @@ -350,7 +350,7 @@ contains start = start - 1 end do Descending call reverse_segment( array(start:finish), & - index(start:finish) ) + adjoint_array(start:finish) ) else Ascending: do while( start > 0 ) if ( array(start) < array(start-1) ) exit Ascending @@ -363,7 +363,7 @@ contains Insert: do while ( start > 0 ) if ( finish - start >= min_run - 1 ) exit Insert start = start - 1 - call insert_head( array(start:finish), index(start:finish) ) + call insert_head( array(start:finish), adjoint_array(start:finish) ) end do Insert if ( start == 0 .and. finish == array_size - 1 ) return @@ -382,7 +382,7 @@ contains call merge( array( left % base: & right % base + right % len - 1 ), & left % len, buf, & - index( left % base: & + adjoint_array( left % base: & right % base + right % len - 1 ), ibuf ) runs(r) = run_type( base = left % base, & @@ -398,7 +398,7 @@ contains end subroutine merge_sort - pure subroutine merge( array, mid, buf, index, ibuf ) + pure subroutine merge( array, mid, buf, adjoint_array, ibuf ) ! Merges the two non-decreasing runs `ARRAY(0:MID-1)` and `ARRAY(MID:)` ! using `BUF` as temporary storage, and stores the merged runs into ! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF` @@ -406,7 +406,7 @@ contains ${t1}$, intent(inout) :: array(0:) integer(int_index), intent(in) :: mid ${t3}$, intent(inout) :: buf(0:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${ti}$, intent(inout) :: ibuf(0:) integer(int_index) :: array_len, i, j, k @@ -420,44 +420,44 @@ contains if ( mid <= array_len - mid ) then ! The left run is shorter. buf(0:mid-1) = array(0:mid-1) - ibuf(0:mid-1) = index(0:mid-1) + ibuf(0:mid-1) = adjoint_array(0:mid-1) i = 0 j = mid merge_lower: do k = 0, array_len-1 if ( buf(i) <= array(j) ) then array(k) = buf(i) - index(k) = ibuf(i) + adjoint_array(k) = ibuf(i) i = i + 1 if ( i >= mid ) exit merge_lower else array(k) = array(j) - index(k) = index(j) + adjoint_array(k) = adjoint_array(j) j = j + 1 if ( j >= array_len ) then array(k+1:) = buf(i:mid-1) - index(k+1:) = ibuf(i:mid-1) + adjoint_array(k+1:) = ibuf(i:mid-1) exit merge_lower end if end if end do merge_lower else ! The right run is shorter buf(0:array_len-mid-1) = array(mid:array_len-1) - ibuf(0:array_len-mid-1) = index(mid:array_len-1) + ibuf(0:array_len-mid-1) = adjoint_array(mid:array_len-1) i = mid - 1 j = array_len - mid -1 merge_upper: do k = array_len-1, 0, -1 if ( buf(j) >= array(i) ) then array(k) = buf(j) - index(k) = ibuf(j) + adjoint_array(k) = ibuf(j) j = j - 1 if ( j < 0 ) exit merge_upper else array(k) = array(i) - index(k) = index(i) + adjoint_array(k) = adjoint_array(i) i = i - 1 if ( i < 0 ) then array(0:k-1) = buf(0:j) - index(0:k-1) = ibuf(0:j) + adjoint_array(0:k-1) = ibuf(0:j) exit merge_upper end if end if @@ -466,10 +466,10 @@ contains end subroutine merge - pure subroutine reverse_segment( array, index ) + pure subroutine reverse_segment( array, adjoint_array ) ! Reverse a segment of an array in place ${t1}$, intent(inout) :: array(0:) - ${ti}$, intent(inout) :: index(0:) + ${ti}$, intent(inout) :: adjoint_array(0:) ${ti}$ :: itemp integer(int_index) :: lo, hi @@ -481,9 +481,9 @@ contains temp = array(lo) array(lo) = array(hi) array(hi) = temp - itemp = index(lo) - index(lo) = index(hi) - index(hi) = itemp + itemp = adjoint_array(lo) + adjoint_array(lo) = adjoint_array(hi) + adjoint_array(hi) = itemp lo = lo + 1 hi = hi - 1 end do From c8981f9e64c3f2135f31d78d7b1e1325266443fb Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 10 Jul 2024 21:04:13 +0200 Subject: [PATCH 09/11] update specs --- doc/specs/stdlib_sorting.md | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index 35cb6a55f..a618a6768 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -46,7 +46,7 @@ data: * `ORD_SORT` is intended to sort simple arrays of intrinsic data that have significant sections that were partially ordered before the sort; -* `SORT_ADJ` is based on `ORD_SORT`, but in addition to sorting the +* `SORT_ADJOINT` is based on `ORD_SORT`, but in addition to sorting the input array, it returns a related array re-ordered in the same way; * `SORT_INDEX` is based on `ORD_SORT`, but in addition to sorting the @@ -63,10 +63,10 @@ data: The Fortran Standard Library is distributed under the MIT License. However components of the library may be based on code with additional licensing restrictions. In particular `ORD_SORT`, -`SORT_ADJ`, `SORT_INDEX`, and `SORT` are translations of codes with their +`SORT_ADJOINT`, `SORT_INDEX`, and `SORT` are translations of codes with their own distribution restrictions. -The `ORD_SORT`, `SORT_ADJ` and `SORT_INDEX` subroutines are essentially +The `ORD_SORT`, `SORT_ADJOINT` and `SORT_INDEX` subroutines are essentially translations to Fortran 2008 of the `"Rust" sort` of the Rust Language distributed as part of [`slice.rs`](https://github.com/rust-lang/rust/blob/90eb44a5897c39e3dff9c7e48e3973671dcd9496/src/liballoc/slice.rs). @@ -143,20 +143,20 @@ argument or allocated internally on the stack. Arrays can be also sorted in a decreasing order by providing the argument `reverse = .true.`. -#### The `SORT_ADJ` subroutine +#### The `SORT_ADJOINT` subroutine The `SORT` and `ORD_SORT` subroutines can sort rank 1 isolated arrays of intrinsic types, but do nothing for the coordinated sorting of related data, e.g., a related rank 1 array. Therefore the module -provides a subroutine, `SORT_ADJ`, that re-order such a rank 1 array +provides a subroutine, `SORT_ADJOINT`, that re-order such a rank 1 array in the same way as the input array based on the `ORD_SORT` algorithm, in addition to sorting the input array. -The logic of `SORT_ADJ` parallels that of `ORD_SORT`, with +The logic of `SORT_ADJOINT` parallels that of `ORD_SORT`, with additional housekeeping to keep the associated array consistent with the sorted positions of the input array. Because of this additional housekeeping it has slower runtime performance than `ORD_SORT`. -`SORT_ADJ` requires the use of two "scratch" arrays, that may be +`SORT_ADJOINT` requires the use of two "scratch" arrays, that may be provided as optional `work` and `iwork` arguments or allocated internally on the stack. @@ -218,7 +218,7 @@ factor of six. Still, even when it shows enhanced performance, its performance on partially sorted data is typically an order of magnitude slower than `ORD_SORT`. Its memory requirements are also low, being of order O(Ln(N)), while the memory requirements of -`ORD_SORT`, `SORT_ADJ` and `SORT_INDEX` are of order O(N). +`ORD_SORT`, `SORT_ADJOINT` and `SORT_INDEX` are of order O(N). #### The `RADIX_SORT` subroutine @@ -405,7 +405,7 @@ element of `array` is a `NaN`. {!example/sorting/example_radix_sort.f90!} ``` -#### `sort_adj` - sorts an associated array in the same way as the input array, while also sorting the array. +#### `sort_adjoint` - sorts an associated array in the same way as the input array, while also sorting the array. ##### Status @@ -419,7 +419,7 @@ sorted in the same way as the input `array`. ##### Syntax -`call ` [[stdlib_sorting(module):sort_adj(interface)]] `( array, index[, work, iwork, reverse ] )` +`call ` [[stdlib_sorting(module):sort_adjoint(interface)]] `( array, adjoint_array[, work, iwork, reverse ] )` ##### Class @@ -435,7 +435,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` or `real` array of +`adjoint_array`: shall be a rank one `integer` or `real` array of the size of `array`. It is an `intent(inout)` argument. On return it shall have values that are the indices needed to sort the original array in the desired direction. @@ -448,7 +448,7 @@ 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 the same kind -of the array `index`, and shall have at least `size(array)/2` elements. It +of the array `adjoint_array`, 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 @@ -462,13 +462,13 @@ values in stable order. ##### Notes -`SORT_ADJ` implements the hybrid sorting algorithm of `ORD_SORT`, -keeping the values of `index` consistent with the elements of `array` +`SORT_ADJOINT` implements the hybrid sorting algorithm of `ORD_SORT`, +keeping the values of `adjoint_array` consistent with the elements of `array` as it is sorted. As a `merge sort` based algorithm, it is a stable sorting comparison algorithm. The optional `work` and `iwork` arrays replace "scratch" memory that would otherwise be allocated on the stack. If `array` is of any kind of `REAL` the order of the elements in -`index` and `array` on return are undefined if any element of `array` +`adjoint_array` and `array` on return are undefined if any element of `array` is a `NaN`. Sorting of `CHARACTER(*)` and `STRING_TYPE` arrays are based on the operator `>`, and not on the function `LGT`. @@ -477,10 +477,10 @@ different on return ##### Examples -Sorting a rank one array with `sort_adj`: +Sorting a rank one array with `sort_adjoint`: ```Fortran -{!example/sorting/example_sort_adj.f90!} +{!example/sorting/example_sort_adjoint.f90!} ``` #### `sort_index` - creates an array of sorting indices for an input array, while also sorting the array. From 55c29c3fba3808a771c561c759f714929e81de39 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 10 Jul 2024 21:21:45 +0200 Subject: [PATCH 10/11] fix typos --- src/stdlib_sorting_sort_adjoint.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_sorting_sort_adjoint.fypp b/src/stdlib_sorting_sort_adjoint.fypp index a1cfebc32..10b7c0f63 100644 --- a/src/stdlib_sorting_sort_adjoint.fypp +++ b/src/stdlib_sorting_sort_adjoint.fypp @@ -490,10 +490,10 @@ contains end subroutine reverse_segment - end subroutine ${name1}$_${namei}$_sort_adj + end subroutine ${name1}$_${namei}$_sort_adjoint #:endfor #:endfor -end submodule stdlib_sorting_sort_adj +end submodule stdlib_sorting_sort_adjoint From 54fc60792e8ceba70099089d87497c8b6dbd482c Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 6 Aug 2024 09:01:09 -0400 Subject: [PATCH 11/11] Apply suggestions from code review Co-authored-by: Federico Perini --- doc/specs/stdlib_sorting.md | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index a618a6768..dbf395a10 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -47,8 +47,8 @@ data: that have significant sections that were partially ordered before the sort; * `SORT_ADJOINT` is based on `ORD_SORT`, but in addition to sorting the - input array, it returns a related array re-ordered in the - same way; + input array, it re-orders a second array of the same size + according to the same permutations; * `SORT_INDEX` is based on `ORD_SORT`, but in addition to sorting the input array, it returns indices that map the original array to its sorted version. This enables related arrays to be re-ordered in the @@ -149,7 +149,7 @@ The `SORT` and `ORD_SORT` subroutines can sort rank 1 isolated arrays of intrinsic types, but do nothing for the coordinated sorting of related data, e.g., a related rank 1 array. Therefore the module provides a subroutine, `SORT_ADJOINT`, that re-order such a rank 1 array -in the same way as the input array based on the `ORD_SORT` algorithm, +according to the same permutations as for the input array based on the `ORD_SORT` algorithm, in addition to sorting the input array. The logic of `SORT_ADJOINT` parallels that of `ORD_SORT`, with @@ -405,7 +405,8 @@ element of `array` is a `NaN`. {!example/sorting/example_radix_sort.f90!} ``` -#### `sort_adjoint` - sorts an associated array in the same way as the input array, while also sorting the array. +#### `sort_adjoint` - sorts an associated array +according to the same permutations as for the input array. ##### Status @@ -415,7 +416,7 @@ Experimental Returns the input `array` sorted in the direction requested while retaining order stability, and an associated array whose elements are -sorted in the same way as the input `array`. +sorted according to the same permutations as for the input `array`. ##### Syntax