@@ -4,17 +4,17 @@ program test_sorting
4
4
compiler_version
5
5
use stdlib_kinds, only: int32, int64, dp, sp
6
6
use stdlib_sorting
7
- use stdlib_string_type, only: string_type, assignment (= ), operator (>), operator (<), &
8
- write (formatted)
7
+ use stdlib_string_type, only: string_type, assignment (= ), operator (>), &
8
+ operator (<), write (formatted)
9
9
use stdlib_error, only: check
10
10
11
11
implicit none
12
12
13
- integer (int32), parameter :: test_size = 2_int32 ** 20
14
- integer (int32), parameter :: char_size = 26 ** 4
15
- integer (int32), parameter :: string_size = 26 ** 3
13
+ integer (int32), parameter :: test_size = 2_int32 ** 16
14
+ integer (int32), parameter :: char_size = 16 ** 4
15
+ integer (int32), parameter :: string_size = 16 ** 3
16
16
integer (int32), parameter :: block_size = test_size/ 6
17
- integer , parameter :: repeat = 8
17
+ integer , parameter :: repeat = 1
18
18
19
19
integer (int32) :: &
20
20
blocks(0 :test_size-1 ), &
@@ -38,11 +38,12 @@ program test_sorting
38
38
integer (int32) :: dummy(0 :test_size-1 )
39
39
character (len= 4 ) :: char_dummy(0 :char_size-1 )
40
40
type (string_type) :: string_dummy(0 :string_size-1 )
41
- integer (int_size) :: index (0 :test_size-1 )
41
+ integer (int_size) :: index (0 :max ( test_size, char_size, string_size) - 1 )
42
42
integer (int32) :: work(0 :test_size/ 2-1 )
43
43
character (len= 4 ) :: char_work(0 :char_size/ 2-1 )
44
44
type (string_type) :: string_work(0 :string_size/ 2-1 )
45
- integer (int_size) :: iwork(0 :test_size/ 2-1 )
45
+ integer (int_size) :: iwork(0 :max (test_size, char_size, &
46
+ string_size)/ 2-1 )
46
47
integer :: count, i, index1, index2, j, k, l, temp
47
48
real (sp) :: arand, brand
48
49
character (* ), parameter :: filename = ' test_sorting.txt'
@@ -91,10 +92,10 @@ program test_sorting
91
92
end do
92
93
93
94
count = 0
94
- do i= 0 , 25
95
- do j= 0 , 25
96
- do k= 0 , 25
97
- do l= 0 , 25
95
+ do i= 0 , 15
96
+ do j= 0 , 15
97
+ do k= 0 , 15
98
+ do l= 0 , 15
98
99
char_increase(count) = achar (97 + i) // achar (97 + j) // &
99
100
achar (97 + k) // achar (97 + l)
100
101
count = count + 1
@@ -117,9 +118,9 @@ program test_sorting
117
118
end do
118
119
119
120
count = 0
120
- do i= 0 , 25
121
- do j= 0 , 25
122
- do k= 0 , 25
121
+ do i= 0 , 15
122
+ do j= 0 , 15
123
+ do k= 0 , 15
123
124
string_increase(count) = achar (97 + i) // achar (97 + j) // &
124
125
achar (97 + k)
125
126
count = count + 1
@@ -171,7 +172,6 @@ program test_sorting
171
172
172
173
call test_string_sort_indexes( ldummy ); ltest = (ltest .and. ldummy)
173
174
174
-
175
175
call check(ltest)
176
176
177
177
contains
@@ -244,7 +244,7 @@ subroutine test_int_ord_sort( a, a_name, ltest )
244
244
write (* ,' (a12, 2i7)' ) ' dummy(i-1:i) = ' , dummy(i-1 :i)
245
245
end if
246
246
write ( lun, ' ("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
247
- ' a12, " |", F10.5 , " |" )' ) &
247
+ ' a12, " |", F10.6 , " |" )' ) &
248
248
test_size, a_name, " Ord_Sort" , tdiff/ rate
249
249
250
250
! reverse
@@ -316,7 +316,7 @@ subroutine test_char_ord_sort( a, a_name, ltest )
316
316
write (* ,' (a, 2(1x,a4))' ) ' char_dummy(i-1:i) = ' , char_dummy(i-1 :i)
317
317
end if
318
318
write ( lun, ' ("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
319
- ' a12, " |", F10.5 , " |" )' ) &
319
+ ' a12, " |", F10.6 , " |" )' ) &
320
320
char_size, a_name, " Ord_Sort" , tdiff/ rate
321
321
322
322
! reverse
@@ -393,7 +393,7 @@ subroutine test_string_ord_sort( a, a_name, ltest )
393
393
string_dummy(i-1 :i)
394
394
end if
395
395
write ( lun, ' ("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
396
- ' a12, " |", F10.5 , " |" )' ) &
396
+ ' a12, " |", F10.6 , " |" )' ) &
397
397
string_size, a_name, " Ord_Sort" , tdiff/ rate
398
398
399
399
! reverse
@@ -491,7 +491,7 @@ subroutine test_int_sort( a, a_name, ltest )
491
491
write (* ,' (a12, 2i7)' ) ' dummy(i-1:i) = ' , dummy(i-1 :i)
492
492
end if
493
493
write ( lun, ' ("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
494
- ' a12, " |", F10.5 , " |" )' ) &
494
+ ' a12, " |", F10.6 , " |" )' ) &
495
495
test_size, a_name, " Sort" , tdiff/ rate
496
496
497
497
@@ -556,7 +556,7 @@ subroutine test_char_sort( a, a_name, ltest )
556
556
write (* ,' (a17, 2(1x,a4))' ) ' char_dummy(i-1:i) = ' , char_dummy(i-1 :i)
557
557
end if
558
558
write ( lun, ' ("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
559
- ' a12, " |", F10.5 , " |" )' ) &
559
+ ' a12, " |", F10.6 , " |" )' ) &
560
560
char_size, a_name, " Sort" , tdiff/ rate
561
561
562
562
! reverse
@@ -619,7 +619,7 @@ subroutine test_string_sort( a, a_name, ltest )
619
619
string_dummy(i-1 :i)
620
620
end if
621
621
write ( lun, ' ("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
622
- ' a12, " |", F10.5 , " |" )' ) &
622
+ ' a12, " |", F10.6 , " |" )' ) &
623
623
string_size, a_name, " Sort" , tdiff/ rate
624
624
625
625
! reverse
@@ -696,7 +696,7 @@ subroutine test_int_sort_index( a, a_name, ltest )
696
696
end do
697
697
tdiff = tdiff/ repeat
698
698
699
- dummy = a(index)
699
+ dummy = a(index ( 0 : size (a) - 1 ) )
700
700
call verify_sort( dummy, valid, i )
701
701
ltest = (ltest .and. valid)
702
702
if ( .not. valid ) then
@@ -705,12 +705,12 @@ subroutine test_int_sort_index( a, a_name, ltest )
705
705
write (* ,' (a18, 2i7)' ) ' a(index(i-1:i)) = ' , a(index (i-1 :i))
706
706
end if
707
707
write ( lun, ' ("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
708
- ' a12, " |", F10.5 , " |" )' ) &
708
+ ' a12, " |", F10.6 , " |" )' ) &
709
709
test_size, a_name, " Sort_Index" , tdiff/ rate
710
710
711
711
dummy = a
712
712
call sort_index( dummy, index, work, iwork, reverse= .true. )
713
- dummy = a(index)
713
+ dummy = a(index ( size (a) - 1 ) )
714
714
call verify_reverse_sort( dummy, valid, i )
715
715
ltest = (ltest .and. valid)
716
716
if ( .not. valid ) then
@@ -754,21 +754,25 @@ subroutine test_char_sort_index( a, a_name, ltest )
754
754
do i = 1 , repeat
755
755
char_dummy = a
756
756
call system_clock ( t0, rate )
757
+
757
758
call sort_index( char_dummy, index, char_work, iwork )
759
+
758
760
call system_clock ( t1, rate )
761
+
759
762
tdiff = tdiff + t1 - t0
760
763
end do
761
764
tdiff = tdiff/ repeat
762
765
763
766
call verify_char_sort( char_dummy, valid, i )
767
+
764
768
ltest = (ltest .and. valid)
765
769
if ( .not. valid ) then
766
770
write ( * , * ) " SORT_INDEX did not sort " // a_name // " ."
767
771
write (* ,* ) ' i = ' , i
768
772
write (* ,' (a17, 2(1x,a4))' ) ' char_dummy(i-1:i) = ' , char_dummy(i-1 :i)
769
773
end if
770
774
write ( lun, ' ("| Character |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
771
- ' a12, " |", F10.5 , " |" )' ) &
775
+ ' a12, " |", F10.6 , " |" )' ) &
772
776
char_size, a_name, " Sort_Index" , tdiff/ rate
773
777
774
778
end subroutine test_char_sort_index
@@ -820,7 +824,7 @@ subroutine test_string_sort_index( a, a_name, ltest )
820
824
string_dummy(i-1 :i)
821
825
end if
822
826
write ( lun, ' ("| String_type |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
823
- ' a12, " |", F10.5 , " |" )' ) &
827
+ ' a12, " |", F10.6 , " |" )' ) &
824
828
string_size, a_name, " Sort_Index" , tdiff/ rate
825
829
826
830
end subroutine test_string_sort_index
0 commit comments