From 71280a4dc50e69c4a17148aeccd3e9cfa8f99cc4 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 21 May 2024 16:50:11 +0200 Subject: [PATCH 1/2] Rename int_size to int_index in source code --- src/stdlib_sorting.fypp | 32 +++++++------- src/stdlib_sorting_ord_sort.fypp | 46 ++++++++++---------- src/stdlib_sorting_radix_sort.f90 | 58 ++++++++++++------------- src/stdlib_sorting_sort.fypp | 58 ++++++++++++------------- src/stdlib_sorting_sort_index.fypp | 70 +++++++++++++++--------------- test/sorting/test_sorting.f90 | 4 +- 6 files changed, 134 insertions(+), 134 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 6975bcda1..de135bfd0 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -137,7 +137,7 @@ module stdlib_sorting implicit none private - integer, parameter, public :: int_size = int64 !! Integer kind for indexing + integer, parameter, public :: int_index = int64 !! Integer kind for indexing ! Constants for use by tim_sort integer, parameter :: & @@ -152,8 +152,8 @@ module stdlib_sorting !! !! Used to pass state around in a stack among helper functions for the !! `ORD_SORT` and `SORT_INDEX` algorithms - integer(int_size) :: base = 0 - integer(int_size) :: len = 0 + integer(int_index) :: base = 0 + integer(int_index) :: len = 0 end type run_type public ord_sort @@ -313,7 +313,7 @@ module stdlib_sorting !! Otherwise it is defined to be as specified by reverse. !! !! * index: a rank 1 array of sorting indices. It is an `intent(out)` -!! argument of the type `integer(int_size)`. Its size shall be the +!! argument of the type `integer(int_index)`. Its size shall be the !! same as `array`. On return, if defined, its elements would !! sort the input `array` in the direction specified by `reverse`. !! @@ -324,7 +324,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 kind `int_size`, +!! * iwork (optional): shall be a rank 1 integer array of kind `int_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 @@ -347,8 +347,8 @@ module stdlib_sorting !! 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(:) +!! integer(int_index), intent(out) :: index(:) +!! integer(int_index), 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)) @@ -365,8 +365,8 @@ module stdlib_sorting !! integer, intent(inout) :: a(:,:) !! integer(int32), intent(in) :: column !! integer(int32), intent(out) :: work(:) -!! integer(int_size), intent(out) :: index(:) -!! integer(int_size), intent(out) :: iwork(:) +!! integer(int_index), intent(out) :: index(:) +!! integer(int_index), intent(out) :: iwork(:) !! integer, allocatable :: dummy(:) !! integer :: i !! allocate(dummy(size(a, dim=1))) @@ -389,8 +389,8 @@ module stdlib_sorting !! 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(:) +!! integer(int_index), intent(out) :: index(:) +!! integer(int_index), intent(out) :: iwork(:) !! ! Extract a component of `a_data` !! a(1:size(a_data)) = a_data(:) % a !! ! Find the indices to sort the component @@ -525,11 +525,11 @@ module stdlib_sorting !! 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:) - ${t2}$, intent(out), optional :: work(0:) - integer(int_size), intent(out), optional :: iwork(0:) - logical, intent(in), optional :: reverse + ${t1}$, intent(inout) :: array(0:) + integer(int_index), intent(out) :: index(0:) + ${t2}$, intent(out), optional :: work(0:) + integer(int_index), intent(out), optional :: iwork(0:) + logical, intent(in), optional :: reverse end subroutine ${name1}$_sort_index #:endfor diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 4c5ea24c7..efc218d56 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -113,12 +113,12 @@ contains ${t3}$, intent(out), optional :: work(0:) ${t2}$, allocatable :: buf(:) - integer(int_size) :: array_size + integer(int_index) :: array_size integer :: stat - array_size = size( array, kind=int_size ) + array_size = size( array, kind=int_index ) if ( present(work) ) then - if ( size( work, kind=int_size) < array_size/2 ) then + if ( size( work, kind=int_index) < array_size/2 ) then error stop "${name1}$_${sname}$_ord_sort: work array is too small." endif ! Use the work array as scratch memory @@ -141,17 +141,17 @@ contains !! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is !! less than or equal to a power of two. See !! https://svn.python.org/projects/python/trunk/Objects/listsort.txt - integer(int_size) :: min_run - integer(int_size), intent(in) :: n + integer(int_index) :: min_run + integer(int_index), intent(in) :: n - integer(int_size) :: num, r + integer(int_index) :: num, r num = n - r = 0_int_size + r = 0_int_index do while( num >= 64 ) - r = ior( r, iand(num, 1_int_size) ) - num = ishft(num, -1_int_size) + r = ior( r, iand(num, 1_int_index) ) + num = ishft(num, -1_int_index) end do min_run = num + r @@ -162,10 +162,10 @@ contains ! Sorts `ARRAY` using an insertion sort. ${t1}$, intent(inout) :: array(0:) - integer(int_size) :: i, j + integer(int_index) :: i, j ${t3}$ :: key - do j=1, size(array, kind=int_size)-1 + do j=1, size(array, kind=int_index)-1 key = array(j) i = j - 1 do while( i >= 0 ) @@ -185,13 +185,13 @@ contains ! ! 1. len(-3) > len(-2) + len(-1) ! 2. len(-2) > len(-1) - integer(int_size) :: r + integer(int_index) :: r type(run_type), intent(in), target :: runs(0:) - integer(int_size) :: n + integer(int_index) :: n logical :: test - n = size(runs, kind=int_size) + n = size(runs, kind=int_index) test = .false. if (n >= 2) then if ( runs( n-1 ) % base == 0 .or. & @@ -240,10 +240,10 @@ contains ${t1}$, intent(inout) :: array(0:) ${t3}$ :: tmp - integer(int_size) :: i + integer(int_index) :: i tmp = array(0) - find_hole: do i=1, size(array, kind=int_size)-1 + find_hole: do i=1, size(array, kind=int_index)-1 if ( array(i) ${signt}$= tmp ) exit find_hole array(i-1) = array(i) end do find_hole @@ -275,11 +275,11 @@ contains ${t1}$, intent(inout) :: array(0:) ${t3}$, intent(inout) :: buf(0:) - integer(int_size) :: array_size, finish, min_run, r, r_count, & + integer(int_index) :: array_size, finish, min_run, r, r_count, & start type(run_type) :: runs(0:max_merge_stack-1), left, right - array_size = size(array, kind=int_size) + array_size = size(array, kind=int_index) ! Very short runs are extended using insertion sort to span at least ! min_run elements. Slices of up to this length are sorted using insertion @@ -361,12 +361,12 @@ contains ! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF` ! must be long enough to hold the shorter of the two runs. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(in) :: mid + integer(int_index), intent(in) :: mid ${t3}$, intent(inout) :: buf(0:) - integer(int_size) :: array_len, i, j, k + integer(int_index) :: array_len, i, j, k - array_len = size(array, kind=int_size) + array_len = size(array, kind=int_index) ! Merge first copies the shorter run into `buf`. Then, depending on which ! run was shorter, it traces the copied run and the longer run forwards @@ -417,11 +417,11 @@ contains ! Reverse a segment of an array in place ${t1}$, intent(inout) :: array(0:) - integer(int_size) :: lo, hi + integer(int_index) :: lo, hi ${t3}$ :: temp lo = 0 - hi = size( array, kind=int_size ) - 1 + hi = size( array, kind=int_index ) - 1 do while( lo < hi ) temp = array(lo) array(lo) = array(hi) diff --git a/src/stdlib_sorting_radix_sort.f90 b/src/stdlib_sorting_radix_sort.f90 index 9b23562f7..6824060e6 100644 --- a/src/stdlib_sorting_radix_sort.f90 +++ b/src/stdlib_sorting_radix_sort.f90 @@ -13,11 +13,11 @@ contains ! For int8, radix sort becomes counting sort, so buffer is not needed pure subroutine radix_sort_u8_helper(N, arr) - integer(kind=int_size), intent(in) :: N + integer(kind=int_index), intent(in) :: N integer(kind=int8), dimension(N), intent(inout) :: arr - integer(kind=int_size) :: i + integer(kind=int_index) :: i integer :: bin_idx - integer(kind=int_size), dimension(-128:127) :: counts + integer(kind=int_index), dimension(-128:127) :: counts counts(:) = 0 do i = 1, N bin_idx = arr(i) @@ -34,12 +34,12 @@ pure subroutine radix_sort_u8_helper(N, arr) end subroutine pure subroutine radix_sort_u16_helper(N, arr, buf) - integer(kind=int_size), intent(in) :: N + integer(kind=int_index), intent(in) :: N integer(kind=int16), dimension(N), intent(inout) :: arr integer(kind=int16), dimension(N), intent(inout) :: buf - integer(kind=int_size) :: i + integer(kind=int_index) :: i integer :: b, b0, b1 - integer(kind=int_size), dimension(0:radix_mask) :: c0, c1 + integer(kind=int_index), dimension(0:radix_mask) :: c0, c1 c0(:) = 0 c1(:) = 0 do i = 1, N @@ -65,12 +65,12 @@ pure subroutine radix_sort_u16_helper(N, arr, buf) end subroutine pure subroutine radix_sort_u32_helper(N, arr, buf) - integer(kind=int_size), intent(in) :: N + integer(kind=int_index), intent(in) :: N integer(kind=int32), dimension(N), intent(inout) :: arr integer(kind=int32), dimension(N), intent(inout) :: buf - integer(kind=int_size) :: i + integer(kind=int_index) :: i integer :: b, b0, b1, b2, b3 - integer(kind=int_size), dimension(0:radix_mask) :: c0, c1, c2, c3 + integer(kind=int_index), dimension(0:radix_mask) :: c0, c1, c2, c3 c0(:) = 0 c1(:) = 0 c2(:) = 0 @@ -114,12 +114,12 @@ pure subroutine radix_sort_u32_helper(N, arr, buf) end subroutine radix_sort_u32_helper pure subroutine radix_sort_u64_helper(N, arr, buffer) - integer(kind=int_size), intent(in) :: N + integer(kind=int_index), intent(in) :: N integer(kind=int64), dimension(N), intent(inout) :: arr integer(kind=int64), dimension(N), intent(inout) :: buffer - integer(kind=int_size) :: i + integer(kind=int_index) :: i integer(kind=int64) :: b, b0, b1, b2, b3, b4, b5, b6, b7 - integer(kind=int_size), dimension(0:radix_mask) :: c0, c1, c2, c3, c4, c5, c6, c7 + integer(kind=int_index), dimension(0:radix_mask) :: c0, c1, c2, c3, c4, c5, c6, c7 c0(:) = 0 c1(:) = 0 c2(:) = 0 @@ -202,8 +202,8 @@ pure module subroutine int8_radix_sort(array, reverse) integer(kind=int8), dimension(:), intent(inout) :: array logical, intent(in), optional :: reverse integer(kind=int8) :: item - integer(kind=int_size) :: i, N - N = size(array, kind=int_size) + integer(kind=int_index) :: i, N + N = size(array, kind=int_index) call radix_sort_u8_helper(N, array) if (optval(reverse, .false.)) then do i = 1, N/2 @@ -218,13 +218,13 @@ pure module subroutine int16_radix_sort(array, work, reverse) integer(kind=int16), dimension(:), intent(inout) :: array integer(kind=int16), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse - integer(kind=int_size) :: i, N, start, middle, end + integer(kind=int_index) :: i, N, start, middle, end integer(kind=int16), dimension(:), pointer :: buffer integer(kind=int16) :: item logical :: use_internal_buffer - N = size(array, kind=int_size) + N = size(array, kind=int_index) if (present(work)) then - if (size(work, kind=int_size) < N) then + if (size(work, kind=int_index) < N) then error stop "int16_radix_sort: work array is too small." end if use_internal_buffer = .false. @@ -270,13 +270,13 @@ pure module subroutine int32_radix_sort(array, work, reverse) integer(kind=int32), dimension(:), intent(inout) :: array integer(kind=int32), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse - integer(kind=int_size) :: i, N, start, middle, end + integer(kind=int_index) :: i, N, start, middle, end integer(kind=int32), dimension(:), pointer :: buffer integer(kind=int32) :: item logical :: use_internal_buffer - N = size(array, kind=int_size) + N = size(array, kind=int_index) if (present(work)) then - if (size(work, kind=int_size) < N) then + if (size(work, kind=int_index) < N) then error stop "int32_radix_sort: work array is too small." end if use_internal_buffer = .false. @@ -320,14 +320,14 @@ module subroutine sp_radix_sort(array, work, reverse) real(kind=sp), dimension(:), intent(inout), target :: array real(kind=sp), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse - integer(kind=int_size) :: i, N, pos, rev_pos + integer(kind=int_index) :: i, N, pos, rev_pos integer(kind=int32), dimension(:), pointer :: arri32 integer(kind=int32), dimension(:), pointer :: buffer real(kind=sp) :: item logical :: use_internal_buffer - N = size(array, kind=int_size) + N = size(array, kind=int_index) if (present(work)) then - if (size(work, kind=int_size) < N) then + if (size(work, kind=int_index) < N) then error stop "sp_radix_sort: work array is too small." end if use_internal_buffer = .false. @@ -373,13 +373,13 @@ pure module subroutine int64_radix_sort(array, work, reverse) integer(kind=int64), dimension(:), intent(inout) :: array integer(kind=int64), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse - integer(kind=int_size) :: i, N, start, middle, end + integer(kind=int_index) :: i, N, start, middle, end integer(kind=int64), dimension(:), pointer :: buffer integer(kind=int64) :: item logical :: use_internal_buffer - N = size(array, kind=int_size) + N = size(array, kind=int_index) if (present(work)) then - if (size(work, kind=int_size) < N) then + if (size(work, kind=int_index) < N) then error stop "int64_radix_sort: work array is too small." end if use_internal_buffer = .false. @@ -423,14 +423,14 @@ module subroutine dp_radix_sort(array, work, reverse) real(kind=dp), dimension(:), intent(inout), target :: array real(kind=dp), dimension(:), intent(inout), target, optional :: work logical, intent(in), optional :: reverse - integer(kind=int_size) :: i, N, pos, rev_pos + integer(kind=int_index) :: i, N, pos, rev_pos integer(kind=int64), dimension(:), pointer :: arri64 integer(kind=int64), dimension(:), pointer :: buffer real(kind=dp) :: item logical :: use_internal_buffer - N = size(array, kind=int_size) + N = size(array, kind=int_index) if (present(work)) then - if (size(work, kind=int_size) < N) then + if (size(work, kind=int_index) < N) then error stop "sp_radix_sort: work array is too small." end if use_internal_buffer = .false. diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index 4a9171f77..dcca28a0d 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -106,7 +106,7 @@ contains integer(int32) :: depth_limit - depth_limit = 2 * int( floor( log( real( size( array, kind=int_size), & + depth_limit = 2 * int( floor( log( real( size( array, kind=int_index), & kind=dp) ) / log(2.0_dp) ), & kind=int32 ) call introsort(array, depth_limit) @@ -121,10 +121,10 @@ contains ${t1}$, intent(inout) :: array(0:) integer(int32), intent(in) :: depth_limit - integer(int_size), parameter :: insert_size = 16_int_size - integer(int_size) :: index + integer(int_index), parameter :: insert_size = 16_int_index + integer(int_index) :: index - if ( size(array, kind=int_size) <= insert_size ) then + if ( size(array, kind=int_index) <= insert_size ) then ! May be best at the end of SORT processing the whole array ! See Musser, D.R., “Introspective Sorting and Selection ! Algorithms,” Software—Practice and Experience, Vol. 27(8), @@ -145,32 +145,32 @@ contains pure subroutine partition( array, index ) ! quicksort partition using median of three. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(out) :: index + integer(int_index), intent(out) :: index ${t2}$ :: u, v, w, x, y - integer(int_size) :: i, j + integer(int_index) :: i, j ! Determine median of three and exchange it with the end. u = array( 0 ) - v = array( size(array, kind=int_size)/2-1 ) - w = array( size(array, kind=int_size)-1 ) + v = array( size(array, kind=int_index)/2-1 ) + w = array( size(array, kind=int_index)-1 ) if ( (u ${signt}$ v) .neqv. (u ${signt}$ w) ) then x = u y = array(0) - array(0) = array( size( array, kind=int_size ) - 1 ) - array( size( array, kind=int_size ) - 1 ) = y + array(0) = array( size( array, kind=int_index ) - 1 ) + array( size( array, kind=int_index ) - 1 ) = y else if ( (v ${signoppt}$ u) .neqv. (v ${signoppt}$ w) ) then x = v - y = array(size( array, kind=int_size )/2-1) - array( size( array, kind=int_size )/2-1 ) = & - array( size( array, kind=int_size )-1 ) - array( size( array, kind=int_size )-1 ) = y + y = array(size( array, kind=int_index )/2-1) + array( size( array, kind=int_index )/2-1 ) = & + array( size( array, kind=int_index )-1 ) + array( size( array, kind=int_index )-1 ) = y else x = w end if ! Partition the array. - i = -1_int_size - do j = 0_int_size, size(array, kind=int_size)-2 + i = -1_int_index + do j = 0_int_index, size(array, kind=int_index)-2 if ( array(j) ${signoppt}$= x ) then i = i + 1 y = array(i) @@ -179,8 +179,8 @@ contains end if end do y = array(i+1) - array(i+1) = array(size(array, kind=int_size)-1) - array(size(array, kind=int_size)-1) = y + array(i+1) = array(size(array, kind=int_index)-1) + array(size(array, kind=int_index)-1) = y index = i + 1 end subroutine partition @@ -189,10 +189,10 @@ contains ! Bog standard insertion sort. ${t1}$, intent(inout) :: array(0:) - integer(int_size) :: i, j + integer(int_index) :: i, j ${t2}$ :: key - do j=1_int_size, size(array, kind=int_size)-1 + do j=1_int_index, size(array, kind=int_index)-1 key = array(j) i = j - 1 do while( i >= 0 ) @@ -209,21 +209,21 @@ contains ! A bog standard heap sort ${t1}$, intent(inout) :: array(0:) - integer(int_size) :: i, heap_size + integer(int_index) :: i, heap_size ${t2}$ :: y - heap_size = size( array, kind=int_size ) + heap_size = size( array, kind=int_index ) ! Build the max heap - do i = (heap_size-2)/2_int_size, 0_int_size, -1_int_size + do i = (heap_size-2)/2_int_index, 0_int_index, -1_int_index call max_heapify( array, i, heap_size ) end do - do i = heap_size-1, 1_int_size, -1_int_size + do i = heap_size-1, 1_int_index, -1_int_index ! Swap the first element with the current final element y = array(0) array(0) = array(i) array(i) = y ! Sift down using max_heapify - call max_heapify( array, 0_int_size, i ) + call max_heapify( array, 0_int_index, i ) end do end subroutine heap_sort @@ -231,14 +231,14 @@ contains pure recursive subroutine max_heapify( array, i, heap_size ) ! Transform the array into a max heap ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(in) :: i, heap_size + integer(int_index), intent(in) :: i, heap_size - integer(int_size) :: l, r, largest + integer(int_index) :: l, r, largest ${t2}$ :: y largest = i - l = 2_int_size * i + 1_int_size - r = l + 1_int_size + l = 2_int_index * i + 1_int_index + r = l + 1_int_index if ( l < heap_size ) then if ( array(l) ${signt}$ array(largest) ) largest = l end if diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index 6f0101219..0680d1feb 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -94,16 +94,16 @@ contains ! used as scratch memory. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(out) :: index(0:) + integer(int_index), intent(out) :: index(0:) ${t3}$, intent(out), optional :: work(0:) - integer(int_size), intent(out), optional :: iwork(0:) + integer(int_index), intent(out), optional :: iwork(0:) logical, intent(in), optional :: reverse - integer(int_size) :: array_size, i, stat + integer(int_index) :: array_size, i, stat ${t2}$, allocatable :: buf(:) - integer(int_size), allocatable :: ibuf(:) + integer(int_index), allocatable :: ibuf(:) - array_size = size(array, kind=int_size) + array_size = size(array, kind=int_index) do i = 0, array_size-1 index(i) = i+1 @@ -115,11 +115,11 @@ contains ! If necessary allocate buffers to serve as scratch memory. if ( present(work) ) then - if ( size(work, kind=int_size) < array_size/2 ) then + if ( size(work, kind=int_index) < array_size/2 ) then error stop "work array is too small." end if if ( present(iwork) ) then - if ( size(iwork, kind=int_size) < array_size/2 ) then + 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 ) @@ -137,7 +137,7 @@ contains #:endif if ( stat /= 0 ) error stop "Allocation of array buffer failed." if ( present(iwork) ) then - if ( size(iwork, kind=int_size) < array_size/2 ) then + 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 ) @@ -158,17 +158,17 @@ contains !! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is !! less than or equal to a power of two. See !! https://svn.python.org/projects/python/trunk/Objects/listsort.txt - integer(int_size) :: min_run - integer(int_size), intent(in) :: n + integer(int_index) :: min_run + integer(int_index), intent(in) :: n - integer(int_size) :: num, r + integer(int_index) :: num, r num = n - r = 0_int_size + r = 0_int_index do while( num >= 64 ) - r = ior( r, iand(num, 1_int_size) ) - num = ishft(num, -1_int_size) + r = ior( r, iand(num, 1_int_index) ) + num = ishft(num, -1_int_index) end do min_run = num + r @@ -179,12 +179,12 @@ contains ! Sorts `ARRAY` using an insertion sort, while maintaining consistency in ! location of the indices in `INDEX` to the elements of `ARRAY`. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(inout) :: index(0:) + integer(int_index), intent(inout) :: index(0:) - integer(int_size) :: i, j, key_index + integer(int_index) :: i, j, key_index ${t3}$ :: key - do j=1, size(array, kind=int_size)-1 + do j=1, size(array, kind=int_index)-1 key = array(j) key_index = index(j) i = j - 1 @@ -208,13 +208,13 @@ contains ! 1. len(-3) > len(-2) + len(-1) ! 2. len(-2) > len(-1) - integer(int_size) :: r + integer(int_index) :: r type(run_type), intent(in), target :: runs(0:) - integer(int_size) :: n + integer(int_index) :: n logical :: test - n = size(runs, kind=int_size) + n = size(runs, kind=int_index) test = .false. if (n >= 2) then if ( runs( n-1 ) % base == 0 .or. & @@ -263,14 +263,14 @@ contains ! are maintained. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(inout) :: index(0:) + integer(int_index), intent(inout) :: index(0:) ${t3}$ :: tmp - integer(int_size) :: i, tmp_index + integer(int_index) :: i, tmp_index tmp = array(0) tmp_index = index(0) - find_hole: do i=1, size(array, kind=int_size)-1 + 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) @@ -303,15 +303,15 @@ contains ! `array` are maintained. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(inout) :: index(0:) + integer(int_index), intent(inout) :: index(0:) ${t3}$, intent(inout) :: buf(0:) - integer(int_size), intent(inout) :: ibuf(0:) + integer(int_index), intent(inout) :: ibuf(0:) - integer(int_size) :: array_size, finish, min_run, r, r_count, & + integer(int_index) :: array_size, finish, min_run, r, r_count, & start type(run_type) :: runs(0:max_merge_stack-1), left, right - array_size = size(array, kind=int_size) + array_size = size(array, kind=int_index) ! Very short runs are extended using insertion sort to span at least this ! many elements. Slices of up to this length are sorted using insertion sort. @@ -396,14 +396,14 @@ contains ! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF` ! must be long enough to hold the shorter of the two runs. ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(in) :: mid + integer(int_index), intent(in) :: mid ${t3}$, intent(inout) :: buf(0:) - integer(int_size), intent(inout) :: index(0:) - integer(int_size), intent(inout) :: ibuf(0:) + integer(int_index), intent(inout) :: index(0:) + integer(int_index), intent(inout) :: ibuf(0:) - integer(int_size) :: array_len, i, j, k + integer(int_index) :: array_len, i, j, k - array_len = size(array, kind=int_size) + array_len = size(array, kind=int_index) ! Merge first copies the shorter run into `buf`. Then, depending on which ! run was shorter, it traces the copied run and the longer run forwards @@ -461,13 +461,13 @@ contains pure subroutine reverse_segment( array, index ) ! Reverse a segment of an array in place ${t1}$, intent(inout) :: array(0:) - integer(int_size), intent(inout) :: index(0:) + integer(int_index), intent(inout) :: index(0:) - integer(int_size) :: itemp, lo, hi + integer(int_index) :: itemp, lo, hi ${t3}$ :: temp lo = 0 - hi = size( array, kind=int_size ) - 1 + hi = size( array, kind=int_index ) - 1 do while( lo < hi ) temp = array(lo) array(lo) = array(hi) diff --git a/test/sorting/test_sorting.f90 b/test/sorting/test_sorting.f90 index 4c9f1ffa5..99fd35cea 100644 --- a/test/sorting/test_sorting.f90 +++ b/test/sorting/test_sorting.f90 @@ -54,13 +54,13 @@ module test_sorting type(string_type) :: string_dummy(0:string_size-1) type(bitset_large) :: bitsetl_dummy(0:bitset_size-1) type(bitset_64) :: bitset64_dummy(0:bitset_size-1) - integer(int_size) :: index(0:max(test_size, char_size, string_size)-1) + integer(int_index) :: 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, & + integer(int_index) :: iwork(0:max(test_size, char_size, & string_size)/2-1) integer :: count, i, index1, index2, j, k, l, temp real(sp) :: arand, brand From ec383628a75b39daa1d41870f6e3518a05b3b8d0 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 21 May 2024 16:53:54 +0200 Subject: [PATCH 2/2] Rename int_size to int_index in specs --- doc/specs/stdlib_sorting.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_sorting.md b/doc/specs/stdlib_sorting.md index 04720a480..faa21f82f 100644 --- a/doc/specs/stdlib_sorting.md +++ b/doc/specs/stdlib_sorting.md @@ -25,15 +25,15 @@ module's `string_type` type. ## Overview of the module The module `stdlib_sorting` defines several public entities, one -default integer parameter, `int_size`, and four overloaded +default integer parameter, `int_index`, and four overloaded subroutines: `ORD_SORT`, `SORT`, `RADIX_SORT` and `SORT_INDEX`. The overloaded subroutines also each have several specific names for versions corresponding to different types of array arguments. -### The `int_size` parameter +### The `int_index` parameter -The `int_size` parameter is used to specify the kind of integer used -in indexing the various arrays. Currently the module sets `int_size` +The `int_index` parameter is used to specify the kind of integer used +in indexing the various arrays. Currently the module sets `int_index` to the value of `int64` from the `stdlib_kinds` module. ### The module subroutines @@ -414,7 +414,7 @@ It is an `intent(inout)` argument. On input it will be an array whose sorting indices are to be determined. On return it will be the sorted array. -`index`: shall be a rank one integer array of kind `int_size` and of +`index`: shall be a rank one integer array of kind `int_index` and of the size of `array`. It is an `intent(out)` argument. On return it shall have values that are the indices needed to sort the original array in the desired direction. @@ -427,7 +427,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 kind -`int_size`, and shall have at least `size(array)/2` elements. It +`int_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 @@ -465,8 +465,8 @@ Sorting a related rank one array: 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(:) + integer(int_index), intent(out) :: index(:) + integer(int_index), 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)) @@ -483,8 +483,8 @@ Sorting a rank 2 array based on the data in a column 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(int_index), intent(out) :: index(:) + integer(int_index), intent(out) :: iwork(:) integer, allocatable :: dummy(:) integer :: i allocate(dummy(size(array, dim=1))) @@ -508,8 +508,8 @@ Sorting an array of a derived type based on the data in one component 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(:) + integer(int_index), intent(out) :: index(:) + integer(int_index), intent(out) :: iwork(:) ! Extract a component of `a_data` a(1:size(a_data)) = a_data(:) % a ! Find the indices to sort the component