Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit 3d283a7

Browse files
authoredMay 23, 2024
Merge pull request #824 from jvdp1/rename_int_size
Rename `int size` to `int_index`
2 parents 32018f2 + ec38362 commit 3d283a7

File tree

7 files changed

+146
-146
lines changed

7 files changed

+146
-146
lines changed
 

‎doc/specs/stdlib_sorting.md

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -25,15 +25,15 @@ module's `string_type` type.
2525
## Overview of the module
2626

2727
The module `stdlib_sorting` defines several public entities, one
28-
default integer parameter, `int_size`, and four overloaded
28+
default integer parameter, `int_index`, and four overloaded
2929
subroutines: `ORD_SORT`, `SORT`, `RADIX_SORT` and `SORT_INDEX`. The
3030
overloaded subroutines also each have several specific names for
3131
versions corresponding to different types of array arguments.
3232

33-
### The `int_size` parameter
33+
### The `int_index` parameter
3434

35-
The `int_size` parameter is used to specify the kind of integer used
36-
in indexing the various arrays. Currently the module sets `int_size`
35+
The `int_index` parameter is used to specify the kind of integer used
36+
in indexing the various arrays. Currently the module sets `int_index`
3737
to the value of `int64` from the `stdlib_kinds` module.
3838

3939
### The module subroutines
@@ -414,7 +414,7 @@ It is an `intent(inout)` argument. On input it
414414
will be an array whose sorting indices are to be determined. On return
415415
it will be the sorted array.
416416

417-
`index`: shall be a rank one integer array of kind `int_size` and of
417+
`index`: shall be a rank one integer array of kind `int_index` and of
418418
the size of `array`. It is an `intent(out)` argument. On return it
419419
shall have values that are the indices needed to sort the original
420420
array in the desired direction.
@@ -427,7 +427,7 @@ static storage, its use can significantly reduce the stack memory
427427
requirements for the code. Its contents on return are undefined.
428428

429429
`iwork` (optional): shall be a rank one integer array of kind
430-
`int_size`, and shall have at least `size(array)/2` elements. It
430+
`int_index`, and shall have at least `size(array)/2` elements. It
431431
is an `intent(out)` argument. It is intended to be used as "scratch"
432432
memory for internal record keeping. If associated with an array in
433433
static storage, its use can significantly reduce the stack memory
@@ -465,8 +465,8 @@ Sorting a related rank one array:
465465
integer, intent(inout) :: a(:)
466466
integer(int32), intent(inout) :: b(:) ! The same size as a
467467
integer(int32), intent(out) :: work(:)
468-
integer(int_size), intent(out) :: index(:)
469-
integer(int_size), intent(out) :: iwork(:)
468+
integer(int_index), intent(out) :: index(:)
469+
integer(int_index), intent(out) :: iwork(:)
470470
! Find the indices to sort a
471471
call sort_index(a, index(1:size(a)),&
472472
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
483483
integer, intent(inout) :: array(:,:)
484484
integer(int32), intent(in) :: column
485485
integer(int32), intent(out) :: work(:)
486-
integer(int_size), intent(out) :: index(:)
487-
integer(int_size), intent(out) :: iwork(:)
486+
integer(int_index), intent(out) :: index(:)
487+
integer(int_index), intent(out) :: iwork(:)
488488
integer, allocatable :: dummy(:)
489489
integer :: i
490490
allocate(dummy(size(array, dim=1)))
@@ -508,8 +508,8 @@ Sorting an array of a derived type based on the data in one component
508508
type(a_type), intent(inout) :: a_data(:)
509509
integer(int32), intent(inout) :: a(:)
510510
integer(int32), intent(out) :: work(:)
511-
integer(int_size), intent(out) :: index(:)
512-
integer(int_size), intent(out) :: iwork(:)
511+
integer(int_index), intent(out) :: index(:)
512+
integer(int_index), intent(out) :: iwork(:)
513513
! Extract a component of `a_data`
514514
a(1:size(a_data)) = a_data(:) % a
515515
! Find the indices to sort the component

‎src/stdlib_sorting.fypp

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ module stdlib_sorting
137137
implicit none
138138
private
139139

140-
integer, parameter, public :: int_size = int64 !! Integer kind for indexing
140+
integer, parameter, public :: int_index = int64 !! Integer kind for indexing
141141

142142
! Constants for use by tim_sort
143143
integer, parameter :: &
@@ -152,8 +152,8 @@ module stdlib_sorting
152152
!!
153153
!! Used to pass state around in a stack among helper functions for the
154154
!! `ORD_SORT` and `SORT_INDEX` algorithms
155-
integer(int_size) :: base = 0
156-
integer(int_size) :: len = 0
155+
integer(int_index) :: base = 0
156+
integer(int_index) :: len = 0
157157
end type run_type
158158

159159
public ord_sort
@@ -313,7 +313,7 @@ module stdlib_sorting
313313
!! Otherwise it is defined to be as specified by reverse.
314314
!!
315315
!! * index: a rank 1 array of sorting indices. It is an `intent(out)`
316-
!! argument of the type `integer(int_size)`. Its size shall be the
316+
!! argument of the type `integer(int_index)`. Its size shall be the
317317
!! same as `array`. On return, if defined, its elements would
318318
!! sort the input `array` in the direction specified by `reverse`.
319319
!!
@@ -324,7 +324,7 @@ module stdlib_sorting
324324
!! storage, its use can significantly reduce the stack memory requirements
325325
!! for the code. Its value on return is undefined.
326326
!!
327-
!! * iwork (optional): shall be a rank 1 integer array of kind `int_size`,
327+
!! * iwork (optional): shall be a rank 1 integer array of kind `int_index`,
328328
!! and shall have at least `size(array)/2` elements. It is an
329329
!! `intent(out)` argument to be used as "scratch" memory
330330
!! for internal record keeping. If associated with an array in static
@@ -347,8 +347,8 @@ module stdlib_sorting
347347
!! integer, intent(inout) :: a(:)
348348
!! integer(int32), intent(inout) :: b(:) ! The same size as a
349349
!! integer(int32), intent(out) :: work(:)
350-
!! integer(int_size), intent(out) :: index(:)
351-
!! integer(int_size), intent(out) :: iwork(:)
350+
!! integer(int_index), intent(out) :: index(:)
351+
!! integer(int_index), intent(out) :: iwork(:)
352352
!! ! Find the indices to sort a
353353
!! call sort_index(a, index(1:size(a)),&
354354
!! work(1:size(a)/2), iwork(1:size(a)/2))
@@ -365,8 +365,8 @@ module stdlib_sorting
365365
!! integer, intent(inout) :: a(:,:)
366366
!! integer(int32), intent(in) :: column
367367
!! integer(int32), intent(out) :: work(:)
368-
!! integer(int_size), intent(out) :: index(:)
369-
!! integer(int_size), intent(out) :: iwork(:)
368+
!! integer(int_index), intent(out) :: index(:)
369+
!! integer(int_index), intent(out) :: iwork(:)
370370
!! integer, allocatable :: dummy(:)
371371
!! integer :: i
372372
!! allocate(dummy(size(a, dim=1)))
@@ -389,8 +389,8 @@ module stdlib_sorting
389389
!! type(a_type), intent(inout) :: a_data(:)
390390
!! integer(int32), intent(inout) :: a(:)
391391
!! integer(int32), intent(out) :: work(:)
392-
!! integer(int_size), intent(out) :: index(:)
393-
!! integer(int_size), intent(out) :: iwork(:)
392+
!! integer(int_index), intent(out) :: index(:)
393+
!! integer(int_index), intent(out) :: iwork(:)
394394
!! ! Extract a component of `a_data`
395395
!! a(1:size(a_data)) = a_data(:) % a
396396
!! ! Find the indices to sort the component
@@ -525,11 +525,11 @@ module stdlib_sorting
525525
!! using a hybrid sort based on the `"Rust" sort` algorithm found in `slice.rs`
526526
!! and returns the sorted `ARRAY` and an array `INDEX` of indices in the
527527
!! order that would sort the input `ARRAY` in the desired direction.
528-
${t1}$, intent(inout) :: array(0:)
529-
integer(int_size), intent(out) :: index(0:)
530-
${t2}$, intent(out), optional :: work(0:)
531-
integer(int_size), intent(out), optional :: iwork(0:)
532-
logical, intent(in), optional :: reverse
528+
${t1}$, intent(inout) :: array(0:)
529+
integer(int_index), intent(out) :: index(0:)
530+
${t2}$, intent(out), optional :: work(0:)
531+
integer(int_index), intent(out), optional :: iwork(0:)
532+
logical, intent(in), optional :: reverse
533533
end subroutine ${name1}$_sort_index
534534

535535
#:endfor

‎src/stdlib_sorting_ord_sort.fypp

Lines changed: 23 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -113,12 +113,12 @@ contains
113113
${t3}$, intent(out), optional :: work(0:)
114114

115115
${t2}$, allocatable :: buf(:)
116-
integer(int_size) :: array_size
116+
integer(int_index) :: array_size
117117
integer :: stat
118118

119-
array_size = size( array, kind=int_size )
119+
array_size = size( array, kind=int_index )
120120
if ( present(work) ) then
121-
if ( size( work, kind=int_size) < array_size/2 ) then
121+
if ( size( work, kind=int_index) < array_size/2 ) then
122122
error stop "${name1}$_${sname}$_ord_sort: work array is too small."
123123
endif
124124
! Use the work array as scratch memory
@@ -141,17 +141,17 @@ contains
141141
!! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is
142142
!! less than or equal to a power of two. See
143143
!! https://svn.python.org/projects/python/trunk/Objects/listsort.txt
144-
integer(int_size) :: min_run
145-
integer(int_size), intent(in) :: n
144+
integer(int_index) :: min_run
145+
integer(int_index), intent(in) :: n
146146

147-
integer(int_size) :: num, r
147+
integer(int_index) :: num, r
148148

149149
num = n
150-
r = 0_int_size
150+
r = 0_int_index
151151

152152
do while( num >= 64 )
153-
r = ior( r, iand(num, 1_int_size) )
154-
num = ishft(num, -1_int_size)
153+
r = ior( r, iand(num, 1_int_index) )
154+
num = ishft(num, -1_int_index)
155155
end do
156156
min_run = num + r
157157

@@ -162,10 +162,10 @@ contains
162162
! Sorts `ARRAY` using an insertion sort.
163163
${t1}$, intent(inout) :: array(0:)
164164

165-
integer(int_size) :: i, j
165+
integer(int_index) :: i, j
166166
${t3}$ :: key
167167

168-
do j=1, size(array, kind=int_size)-1
168+
do j=1, size(array, kind=int_index)-1
169169
key = array(j)
170170
i = j - 1
171171
do while( i >= 0 )
@@ -185,13 +185,13 @@ contains
185185
!
186186
! 1. len(-3) > len(-2) + len(-1)
187187
! 2. len(-2) > len(-1)
188-
integer(int_size) :: r
188+
integer(int_index) :: r
189189
type(run_type), intent(in), target :: runs(0:)
190190

191-
integer(int_size) :: n
191+
integer(int_index) :: n
192192
logical :: test
193193

194-
n = size(runs, kind=int_size)
194+
n = size(runs, kind=int_index)
195195
test = .false.
196196
if (n >= 2) then
197197
if ( runs( n-1 ) % base == 0 .or. &
@@ -240,10 +240,10 @@ contains
240240
${t1}$, intent(inout) :: array(0:)
241241

242242
${t3}$ :: tmp
243-
integer(int_size) :: i
243+
integer(int_index) :: i
244244

245245
tmp = array(0)
246-
find_hole: do i=1, size(array, kind=int_size)-1
246+
find_hole: do i=1, size(array, kind=int_index)-1
247247
if ( array(i) ${signt}$= tmp ) exit find_hole
248248
array(i-1) = array(i)
249249
end do find_hole
@@ -275,11 +275,11 @@ contains
275275
${t1}$, intent(inout) :: array(0:)
276276
${t3}$, intent(inout) :: buf(0:)
277277

278-
integer(int_size) :: array_size, finish, min_run, r, r_count, &
278+
integer(int_index) :: array_size, finish, min_run, r, r_count, &
279279
start
280280
type(run_type) :: runs(0:max_merge_stack-1), left, right
281281

282-
array_size = size(array, kind=int_size)
282+
array_size = size(array, kind=int_index)
283283

284284
! Very short runs are extended using insertion sort to span at least
285285
! min_run elements. Slices of up to this length are sorted using insertion
@@ -361,12 +361,12 @@ contains
361361
! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF`
362362
! must be long enough to hold the shorter of the two runs.
363363
${t1}$, intent(inout) :: array(0:)
364-
integer(int_size), intent(in) :: mid
364+
integer(int_index), intent(in) :: mid
365365
${t3}$, intent(inout) :: buf(0:)
366366

367-
integer(int_size) :: array_len, i, j, k
367+
integer(int_index) :: array_len, i, j, k
368368

369-
array_len = size(array, kind=int_size)
369+
array_len = size(array, kind=int_index)
370370

371371
! Merge first copies the shorter run into `buf`. Then, depending on which
372372
! run was shorter, it traces the copied run and the longer run forwards
@@ -417,11 +417,11 @@ contains
417417
! Reverse a segment of an array in place
418418
${t1}$, intent(inout) :: array(0:)
419419

420-
integer(int_size) :: lo, hi
420+
integer(int_index) :: lo, hi
421421
${t3}$ :: temp
422422

423423
lo = 0
424-
hi = size( array, kind=int_size ) - 1
424+
hi = size( array, kind=int_index ) - 1
425425
do while( lo < hi )
426426
temp = array(lo)
427427
array(lo) = array(hi)

‎src/stdlib_sorting_radix_sort.f90

Lines changed: 29 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -13,11 +13,11 @@
1313
contains
1414
! For int8, radix sort becomes counting sort, so buffer is not needed
1515
pure subroutine radix_sort_u8_helper(N, arr)
16-
integer(kind=int_size), intent(in) :: N
16+
integer(kind=int_index), intent(in) :: N
1717
integer(kind=int8), dimension(N), intent(inout) :: arr
18-
integer(kind=int_size) :: i
18+
integer(kind=int_index) :: i
1919
integer :: bin_idx
20-
integer(kind=int_size), dimension(-128:127) :: counts
20+
integer(kind=int_index), dimension(-128:127) :: counts
2121
counts(:) = 0
2222
do i = 1, N
2323
bin_idx = arr(i)
@@ -34,12 +34,12 @@ pure subroutine radix_sort_u8_helper(N, arr)
3434
end subroutine
3535

3636
pure subroutine radix_sort_u16_helper(N, arr, buf)
37-
integer(kind=int_size), intent(in) :: N
37+
integer(kind=int_index), intent(in) :: N
3838
integer(kind=int16), dimension(N), intent(inout) :: arr
3939
integer(kind=int16), dimension(N), intent(inout) :: buf
40-
integer(kind=int_size) :: i
40+
integer(kind=int_index) :: i
4141
integer :: b, b0, b1
42-
integer(kind=int_size), dimension(0:radix_mask) :: c0, c1
42+
integer(kind=int_index), dimension(0:radix_mask) :: c0, c1
4343
c0(:) = 0
4444
c1(:) = 0
4545
do i = 1, N
@@ -65,12 +65,12 @@ pure subroutine radix_sort_u16_helper(N, arr, buf)
6565
end subroutine
6666

6767
pure subroutine radix_sort_u32_helper(N, arr, buf)
68-
integer(kind=int_size), intent(in) :: N
68+
integer(kind=int_index), intent(in) :: N
6969
integer(kind=int32), dimension(N), intent(inout) :: arr
7070
integer(kind=int32), dimension(N), intent(inout) :: buf
71-
integer(kind=int_size) :: i
71+
integer(kind=int_index) :: i
7272
integer :: b, b0, b1, b2, b3
73-
integer(kind=int_size), dimension(0:radix_mask) :: c0, c1, c2, c3
73+
integer(kind=int_index), dimension(0:radix_mask) :: c0, c1, c2, c3
7474
c0(:) = 0
7575
c1(:) = 0
7676
c2(:) = 0
@@ -114,12 +114,12 @@ pure subroutine radix_sort_u32_helper(N, arr, buf)
114114
end subroutine radix_sort_u32_helper
115115

116116
pure subroutine radix_sort_u64_helper(N, arr, buffer)
117-
integer(kind=int_size), intent(in) :: N
117+
integer(kind=int_index), intent(in) :: N
118118
integer(kind=int64), dimension(N), intent(inout) :: arr
119119
integer(kind=int64), dimension(N), intent(inout) :: buffer
120-
integer(kind=int_size) :: i
120+
integer(kind=int_index) :: i
121121
integer(kind=int64) :: b, b0, b1, b2, b3, b4, b5, b6, b7
122-
integer(kind=int_size), dimension(0:radix_mask) :: c0, c1, c2, c3, c4, c5, c6, c7
122+
integer(kind=int_index), dimension(0:radix_mask) :: c0, c1, c2, c3, c4, c5, c6, c7
123123
c0(:) = 0
124124
c1(:) = 0
125125
c2(:) = 0
@@ -202,8 +202,8 @@ pure module subroutine int8_radix_sort(array, reverse)
202202
integer(kind=int8), dimension(:), intent(inout) :: array
203203
logical, intent(in), optional :: reverse
204204
integer(kind=int8) :: item
205-
integer(kind=int_size) :: i, N
206-
N = size(array, kind=int_size)
205+
integer(kind=int_index) :: i, N
206+
N = size(array, kind=int_index)
207207
call radix_sort_u8_helper(N, array)
208208
if (optval(reverse, .false.)) then
209209
do i = 1, N/2
@@ -218,13 +218,13 @@ pure module subroutine int16_radix_sort(array, work, reverse)
218218
integer(kind=int16), dimension(:), intent(inout) :: array
219219
integer(kind=int16), dimension(:), intent(inout), target, optional :: work
220220
logical, intent(in), optional :: reverse
221-
integer(kind=int_size) :: i, N, start, middle, end
221+
integer(kind=int_index) :: i, N, start, middle, end
222222
integer(kind=int16), dimension(:), pointer :: buffer
223223
integer(kind=int16) :: item
224224
logical :: use_internal_buffer
225-
N = size(array, kind=int_size)
225+
N = size(array, kind=int_index)
226226
if (present(work)) then
227-
if (size(work, kind=int_size) < N) then
227+
if (size(work, kind=int_index) < N) then
228228
error stop "int16_radix_sort: work array is too small."
229229
end if
230230
use_internal_buffer = .false.
@@ -270,13 +270,13 @@ pure module subroutine int32_radix_sort(array, work, reverse)
270270
integer(kind=int32), dimension(:), intent(inout) :: array
271271
integer(kind=int32), dimension(:), intent(inout), target, optional :: work
272272
logical, intent(in), optional :: reverse
273-
integer(kind=int_size) :: i, N, start, middle, end
273+
integer(kind=int_index) :: i, N, start, middle, end
274274
integer(kind=int32), dimension(:), pointer :: buffer
275275
integer(kind=int32) :: item
276276
logical :: use_internal_buffer
277-
N = size(array, kind=int_size)
277+
N = size(array, kind=int_index)
278278
if (present(work)) then
279-
if (size(work, kind=int_size) < N) then
279+
if (size(work, kind=int_index) < N) then
280280
error stop "int32_radix_sort: work array is too small."
281281
end if
282282
use_internal_buffer = .false.
@@ -320,14 +320,14 @@ module subroutine sp_radix_sort(array, work, reverse)
320320
real(kind=sp), dimension(:), intent(inout), target :: array
321321
real(kind=sp), dimension(:), intent(inout), target, optional :: work
322322
logical, intent(in), optional :: reverse
323-
integer(kind=int_size) :: i, N, pos, rev_pos
323+
integer(kind=int_index) :: i, N, pos, rev_pos
324324
integer(kind=int32), dimension(:), pointer :: arri32
325325
integer(kind=int32), dimension(:), pointer :: buffer
326326
real(kind=sp) :: item
327327
logical :: use_internal_buffer
328-
N = size(array, kind=int_size)
328+
N = size(array, kind=int_index)
329329
if (present(work)) then
330-
if (size(work, kind=int_size) < N) then
330+
if (size(work, kind=int_index) < N) then
331331
error stop "sp_radix_sort: work array is too small."
332332
end if
333333
use_internal_buffer = .false.
@@ -373,13 +373,13 @@ pure module subroutine int64_radix_sort(array, work, reverse)
373373
integer(kind=int64), dimension(:), intent(inout) :: array
374374
integer(kind=int64), dimension(:), intent(inout), target, optional :: work
375375
logical, intent(in), optional :: reverse
376-
integer(kind=int_size) :: i, N, start, middle, end
376+
integer(kind=int_index) :: i, N, start, middle, end
377377
integer(kind=int64), dimension(:), pointer :: buffer
378378
integer(kind=int64) :: item
379379
logical :: use_internal_buffer
380-
N = size(array, kind=int_size)
380+
N = size(array, kind=int_index)
381381
if (present(work)) then
382-
if (size(work, kind=int_size) < N) then
382+
if (size(work, kind=int_index) < N) then
383383
error stop "int64_radix_sort: work array is too small."
384384
end if
385385
use_internal_buffer = .false.
@@ -423,14 +423,14 @@ module subroutine dp_radix_sort(array, work, reverse)
423423
real(kind=dp), dimension(:), intent(inout), target :: array
424424
real(kind=dp), dimension(:), intent(inout), target, optional :: work
425425
logical, intent(in), optional :: reverse
426-
integer(kind=int_size) :: i, N, pos, rev_pos
426+
integer(kind=int_index) :: i, N, pos, rev_pos
427427
integer(kind=int64), dimension(:), pointer :: arri64
428428
integer(kind=int64), dimension(:), pointer :: buffer
429429
real(kind=dp) :: item
430430
logical :: use_internal_buffer
431-
N = size(array, kind=int_size)
431+
N = size(array, kind=int_index)
432432
if (present(work)) then
433-
if (size(work, kind=int_size) < N) then
433+
if (size(work, kind=int_index) < N) then
434434
error stop "sp_radix_sort: work array is too small."
435435
end if
436436
use_internal_buffer = .false.

‎src/stdlib_sorting_sort.fypp

Lines changed: 29 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ contains
106106
107107
integer(int32) :: depth_limit
108108
109-
depth_limit = 2 * int( floor( log( real( size( array, kind=int_size), &
109+
depth_limit = 2 * int( floor( log( real( size( array, kind=int_index), &
110110
kind=dp) ) / log(2.0_dp) ), &
111111
kind=int32 )
112112
call introsort(array, depth_limit)
@@ -121,10 +121,10 @@ contains
121121
${t1}$, intent(inout) :: array(0:)
122122
integer(int32), intent(in) :: depth_limit
123123
124-
integer(int_size), parameter :: insert_size = 16_int_size
125-
integer(int_size) :: index
124+
integer(int_index), parameter :: insert_size = 16_int_index
125+
integer(int_index) :: index
126126
127-
if ( size(array, kind=int_size) <= insert_size ) then
127+
if ( size(array, kind=int_index) <= insert_size ) then
128128
! May be best at the end of SORT processing the whole array
129129
! See Musser, D.R., “Introspective Sorting and Selection
130130
! Algorithms,” Software—Practice and Experience, Vol. 27(8),
@@ -145,32 +145,32 @@ contains
145145
pure subroutine partition( array, index )
146146
! quicksort partition using median of three.
147147
${t1}$, intent(inout) :: array(0:)
148-
integer(int_size), intent(out) :: index
148+
integer(int_index), intent(out) :: index
149149
150150
${t2}$ :: u, v, w, x, y
151-
integer(int_size) :: i, j
151+
integer(int_index) :: i, j
152152
153153
! Determine median of three and exchange it with the end.
154154
u = array( 0 )
155-
v = array( size(array, kind=int_size)/2-1 )
156-
w = array( size(array, kind=int_size)-1 )
155+
v = array( size(array, kind=int_index)/2-1 )
156+
w = array( size(array, kind=int_index)-1 )
157157
if ( (u ${signt}$ v) .neqv. (u ${signt}$ w) ) then
158158
x = u
159159
y = array(0)
160-
array(0) = array( size( array, kind=int_size ) - 1 )
161-
array( size( array, kind=int_size ) - 1 ) = y
160+
array(0) = array( size( array, kind=int_index ) - 1 )
161+
array( size( array, kind=int_index ) - 1 ) = y
162162
else if ( (v ${signoppt}$ u) .neqv. (v ${signoppt}$ w) ) then
163163
x = v
164-
y = array(size( array, kind=int_size )/2-1)
165-
array( size( array, kind=int_size )/2-1 ) = &
166-
array( size( array, kind=int_size )-1 )
167-
array( size( array, kind=int_size )-1 ) = y
164+
y = array(size( array, kind=int_index )/2-1)
165+
array( size( array, kind=int_index )/2-1 ) = &
166+
array( size( array, kind=int_index )-1 )
167+
array( size( array, kind=int_index )-1 ) = y
168168
else
169169
x = w
170170
end if
171171
! Partition the array.
172-
i = -1_int_size
173-
do j = 0_int_size, size(array, kind=int_size)-2
172+
i = -1_int_index
173+
do j = 0_int_index, size(array, kind=int_index)-2
174174
if ( array(j) ${signoppt}$= x ) then
175175
i = i + 1
176176
y = array(i)
@@ -179,8 +179,8 @@ contains
179179
end if
180180
end do
181181
y = array(i+1)
182-
array(i+1) = array(size(array, kind=int_size)-1)
183-
array(size(array, kind=int_size)-1) = y
182+
array(i+1) = array(size(array, kind=int_index)-1)
183+
array(size(array, kind=int_index)-1) = y
184184
index = i + 1
185185
186186
end subroutine partition
@@ -189,10 +189,10 @@ contains
189189
! Bog standard insertion sort.
190190
${t1}$, intent(inout) :: array(0:)
191191
192-
integer(int_size) :: i, j
192+
integer(int_index) :: i, j
193193
${t2}$ :: key
194194
195-
do j=1_int_size, size(array, kind=int_size)-1
195+
do j=1_int_index, size(array, kind=int_index)-1
196196
key = array(j)
197197
i = j - 1
198198
do while( i >= 0 )
@@ -209,36 +209,36 @@ contains
209209
! A bog standard heap sort
210210
${t1}$, intent(inout) :: array(0:)
211211
212-
integer(int_size) :: i, heap_size
212+
integer(int_index) :: i, heap_size
213213
${t2}$ :: y
214214
215-
heap_size = size( array, kind=int_size )
215+
heap_size = size( array, kind=int_index )
216216
! Build the max heap
217-
do i = (heap_size-2)/2_int_size, 0_int_size, -1_int_size
217+
do i = (heap_size-2)/2_int_index, 0_int_index, -1_int_index
218218
call max_heapify( array, i, heap_size )
219219
end do
220-
do i = heap_size-1, 1_int_size, -1_int_size
220+
do i = heap_size-1, 1_int_index, -1_int_index
221221
! Swap the first element with the current final element
222222
y = array(0)
223223
array(0) = array(i)
224224
array(i) = y
225225
! Sift down using max_heapify
226-
call max_heapify( array, 0_int_size, i )
226+
call max_heapify( array, 0_int_index, i )
227227
end do
228228
229229
end subroutine heap_sort
230230
231231
pure recursive subroutine max_heapify( array, i, heap_size )
232232
! Transform the array into a max heap
233233
${t1}$, intent(inout) :: array(0:)
234-
integer(int_size), intent(in) :: i, heap_size
234+
integer(int_index), intent(in) :: i, heap_size
235235
236-
integer(int_size) :: l, r, largest
236+
integer(int_index) :: l, r, largest
237237
${t2}$ :: y
238238
239239
largest = i
240-
l = 2_int_size * i + 1_int_size
241-
r = l + 1_int_size
240+
l = 2_int_index * i + 1_int_index
241+
r = l + 1_int_index
242242
if ( l < heap_size ) then
243243
if ( array(l) ${signt}$ array(largest) ) largest = l
244244
end if

‎src/stdlib_sorting_sort_index.fypp

Lines changed: 35 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -94,16 +94,16 @@ contains
9494
! used as scratch memory.
9595
9696
${t1}$, intent(inout) :: array(0:)
97-
integer(int_size), intent(out) :: index(0:)
97+
integer(int_index), intent(out) :: index(0:)
9898
${t3}$, intent(out), optional :: work(0:)
99-
integer(int_size), intent(out), optional :: iwork(0:)
99+
integer(int_index), intent(out), optional :: iwork(0:)
100100
logical, intent(in), optional :: reverse
101101
102-
integer(int_size) :: array_size, i, stat
102+
integer(int_index) :: array_size, i, stat
103103
${t2}$, allocatable :: buf(:)
104-
integer(int_size), allocatable :: ibuf(:)
104+
integer(int_index), allocatable :: ibuf(:)
105105
106-
array_size = size(array, kind=int_size)
106+
array_size = size(array, kind=int_index)
107107
108108
do i = 0, array_size-1
109109
index(i) = i+1
@@ -115,11 +115,11 @@ contains
115115
116116
! If necessary allocate buffers to serve as scratch memory.
117117
if ( present(work) ) then
118-
if ( size(work, kind=int_size) < array_size/2 ) then
118+
if ( size(work, kind=int_index) < array_size/2 ) then
119119
error stop "work array is too small."
120120
end if
121121
if ( present(iwork) ) then
122-
if ( size(iwork, kind=int_size) < array_size/2 ) then
122+
if ( size(iwork, kind=int_index) < array_size/2 ) then
123123
error stop "iwork array is too small."
124124
endif
125125
call merge_sort( array, index, work, iwork )
@@ -137,7 +137,7 @@ contains
137137
#:endif
138138
if ( stat /= 0 ) error stop "Allocation of array buffer failed."
139139
if ( present(iwork) ) then
140-
if ( size(iwork, kind=int_size) < array_size/2 ) then
140+
if ( size(iwork, kind=int_index) < array_size/2 ) then
141141
error stop "iwork array is too small."
142142
endif
143143
call merge_sort( array, index, buf, iwork )
@@ -158,17 +158,17 @@ contains
158158
!! Returns the minimum length of a run from 32-63 so that N/MIN_RUN is
159159
!! less than or equal to a power of two. See
160160
!! https://svn.python.org/projects/python/trunk/Objects/listsort.txt
161-
integer(int_size) :: min_run
162-
integer(int_size), intent(in) :: n
161+
integer(int_index) :: min_run
162+
integer(int_index), intent(in) :: n
163163
164-
integer(int_size) :: num, r
164+
integer(int_index) :: num, r
165165
166166
num = n
167-
r = 0_int_size
167+
r = 0_int_index
168168
169169
do while( num >= 64 )
170-
r = ior( r, iand(num, 1_int_size) )
171-
num = ishft(num, -1_int_size)
170+
r = ior( r, iand(num, 1_int_index) )
171+
num = ishft(num, -1_int_index)
172172
end do
173173
min_run = num + r
174174
@@ -179,12 +179,12 @@ contains
179179
! Sorts `ARRAY` using an insertion sort, while maintaining consistency in
180180
! location of the indices in `INDEX` to the elements of `ARRAY`.
181181
${t1}$, intent(inout) :: array(0:)
182-
integer(int_size), intent(inout) :: index(0:)
182+
integer(int_index), intent(inout) :: index(0:)
183183
184-
integer(int_size) :: i, j, key_index
184+
integer(int_index) :: i, j, key_index
185185
${t3}$ :: key
186186
187-
do j=1, size(array, kind=int_size)-1
187+
do j=1, size(array, kind=int_index)-1
188188
key = array(j)
189189
key_index = index(j)
190190
i = j - 1
@@ -208,13 +208,13 @@ contains
208208
! 1. len(-3) > len(-2) + len(-1)
209209
! 2. len(-2) > len(-1)
210210
211-
integer(int_size) :: r
211+
integer(int_index) :: r
212212
type(run_type), intent(in), target :: runs(0:)
213213
214-
integer(int_size) :: n
214+
integer(int_index) :: n
215215
logical :: test
216216
217-
n = size(runs, kind=int_size)
217+
n = size(runs, kind=int_index)
218218
test = .false.
219219
if (n >= 2) then
220220
if ( runs( n-1 ) % base == 0 .or. &
@@ -263,14 +263,14 @@ contains
263263
! are maintained.
264264
265265
${t1}$, intent(inout) :: array(0:)
266-
integer(int_size), intent(inout) :: index(0:)
266+
integer(int_index), intent(inout) :: index(0:)
267267
268268
${t3}$ :: tmp
269-
integer(int_size) :: i, tmp_index
269+
integer(int_index) :: i, tmp_index
270270
271271
tmp = array(0)
272272
tmp_index = index(0)
273-
find_hole: do i=1, size(array, kind=int_size)-1
273+
find_hole: do i=1, size(array, kind=int_index)-1
274274
if ( array(i) >= tmp ) exit find_hole
275275
array(i-1) = array(i)
276276
index(i-1) = index(i)
@@ -303,15 +303,15 @@ contains
303303
! `array` are maintained.
304304
305305
${t1}$, intent(inout) :: array(0:)
306-
integer(int_size), intent(inout) :: index(0:)
306+
integer(int_index), intent(inout) :: index(0:)
307307
${t3}$, intent(inout) :: buf(0:)
308-
integer(int_size), intent(inout) :: ibuf(0:)
308+
integer(int_index), intent(inout) :: ibuf(0:)
309309
310-
integer(int_size) :: array_size, finish, min_run, r, r_count, &
310+
integer(int_index) :: array_size, finish, min_run, r, r_count, &
311311
start
312312
type(run_type) :: runs(0:max_merge_stack-1), left, right
313313
314-
array_size = size(array, kind=int_size)
314+
array_size = size(array, kind=int_index)
315315
316316
! Very short runs are extended using insertion sort to span at least this
317317
! many elements. Slices of up to this length are sorted using insertion sort.
@@ -396,14 +396,14 @@ contains
396396
! `ARRAY(0:)`. `MID` must be > 0, and < `SIZE(ARRAY)-1`. Buffer `BUF`
397397
! must be long enough to hold the shorter of the two runs.
398398
${t1}$, intent(inout) :: array(0:)
399-
integer(int_size), intent(in) :: mid
399+
integer(int_index), intent(in) :: mid
400400
${t3}$, intent(inout) :: buf(0:)
401-
integer(int_size), intent(inout) :: index(0:)
402-
integer(int_size), intent(inout) :: ibuf(0:)
401+
integer(int_index), intent(inout) :: index(0:)
402+
integer(int_index), intent(inout) :: ibuf(0:)
403403

404-
integer(int_size) :: array_len, i, j, k
404+
integer(int_index) :: array_len, i, j, k
405405

406-
array_len = size(array, kind=int_size)
406+
array_len = size(array, kind=int_index)
407407

408408
! Merge first copies the shorter run into `buf`. Then, depending on which
409409
! run was shorter, it traces the copied run and the longer run forwards
@@ -461,13 +461,13 @@ contains
461461
pure subroutine reverse_segment( array, index )
462462
! Reverse a segment of an array in place
463463
${t1}$, intent(inout) :: array(0:)
464-
integer(int_size), intent(inout) :: index(0:)
464+
integer(int_index), intent(inout) :: index(0:)
465465

466-
integer(int_size) :: itemp, lo, hi
466+
integer(int_index) :: itemp, lo, hi
467467
${t3}$ :: temp
468468

469469
lo = 0
470-
hi = size( array, kind=int_size ) - 1
470+
hi = size( array, kind=int_index ) - 1
471471
do while( lo < hi )
472472
temp = array(lo)
473473
array(lo) = array(hi)

‎test/sorting/test_sorting.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -54,13 +54,13 @@ module test_sorting
5454
type(string_type) :: string_dummy(0:string_size-1)
5555
type(bitset_large) :: bitsetl_dummy(0:bitset_size-1)
5656
type(bitset_64) :: bitset64_dummy(0:bitset_size-1)
57-
integer(int_size) :: index(0:max(test_size, char_size, string_size)-1)
57+
integer(int_index) :: index(0:max(test_size, char_size, string_size)-1)
5858
integer(int32) :: work(0:test_size/2-1)
5959
character(len=4) :: char_work(0:char_size/2-1)
6060
type(string_type) :: string_work(0:string_size/2-1)
6161
type(bitset_large) :: bitsetl_work(0:bitset_size/2-1)
6262
type(bitset_64) :: bitset64_work(0:bitset_size/2-1)
63-
integer(int_size) :: iwork(0:max(test_size, char_size, &
63+
integer(int_index) :: iwork(0:max(test_size, char_size, &
6464
string_size)/2-1)
6565
integer :: count, i, index1, index2, j, k, l, temp
6666
real(sp) :: arand, brand

0 commit comments

Comments
 (0)
Please sign in to comment.