Skip to content

Commit f1643c4

Browse files
srinjoy933srinjoy933
committed
updated 4
1 parent 4ac98a2 commit f1643c4

1 file changed

Lines changed: 100 additions & 47 deletions

File tree

‎test/sorting/test_sorting.fypp‎

Lines changed: 100 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -380,7 +380,7 @@ contains
380380
if ( .not. valid ) then
381381
write( *, * ) "ORD_SORT did not sort " // a_name // "."
382382
write(*,*) 'i = ', i
383-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
383+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
384384
end if
385385
write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
386386
'a12, " |", F10.6, " |" )' ) &
@@ -395,7 +395,7 @@ contains
395395
write( *, * ) "reverse + work ORD_SORT did not sort " // a_name // &
396396
"."
397397
write(*,*) 'i = ', i
398-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
398+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
399399
end if
400400

401401
dummy = a
@@ -405,7 +405,7 @@ contains
405405
if ( .not. valid ) then
406406
write( *, * ) "reverse ORD_SORT did not sort " // a_name // "."
407407
write(*,*) 'i = ', i
408-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
408+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
409409
end if
410410

411411
end subroutine test_int_ord_sort
@@ -617,8 +617,8 @@ contains
617617
write(*,*) 'i = ', i
618618
call bitsetl_dummy(i-1)%to_string(bin_im1)
619619
call bitsetl_dummy(i)%to_string(bin_i)
620-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
621-
bin_im1, bin_i
620+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
621+
                bin_im1, bin_i
622622
end if
623623
write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
624624
'a12, " |", F10.6, " |" )' ) &
@@ -636,8 +636,8 @@ contains
636636
write(*,*) 'i = ', i
637637
call bitsetl_dummy(i-1)%to_string(bin_im1)
638638
call bitsetl_dummy(i)%to_string(bin_i)
639-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
640-
bin_im1, bin_i
639+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
640+
                bin_im1, bin_i
641641
end if
642642

643643
bitsetl_dummy = a
@@ -648,10 +648,10 @@ contains
648648
if ( .not. valid ) then
649649
write( *, * ) "reverse ORD_SORT did not sort " // a_name // "."
650650
write(*,*) 'i = ', i
651-
call bitsetl_dummy(i-1)%to_string(bin_im1)
652-
call bitsetl_dummy(i)%to_string(bin_i)
653-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
654-
bin_im1, bin_i
651+
bin_im1 = bitsetl_dummy(i-1)%to_string()
652+
            bin_i = bitsetl_dummy(i)%to_string()
653+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
654+
                bin_im1, bin_i
655655
end if
656656

657657
end subroutine test_bitsetl_ord_sort
@@ -822,7 +822,7 @@ contains
822822
if ( .not. valid ) then
823823
write( *, * ) "RADIX_SORT did not sort " // a_name // "."
824824
write(*,*) 'i = ', i
825-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
825+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
826826
end if
827827
write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
828828
'a12, " |", F10.6, " |" )' ) &
@@ -836,7 +836,7 @@ contains
836836
if ( .not. valid ) then
837837
write( *, * ) "reverse RADIX_SORT did not sort " // a_name // "."
838838
write(*,*) 'i = ', i
839-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
839+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
840840
end if
841841

842842
end subroutine test_int_radix_sort
@@ -975,7 +975,7 @@ contains
975975
if ( .not. valid ) then
976976
write( *, * ) "SORT did not sort " // a_name // "."
977977
write(*,*) 'i = ', i
978-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
978+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
979979
end if
980980
write( lun, '("| Integer |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
981981
'a12, " |", F10.6, " |" )' ) &
@@ -989,7 +989,7 @@ contains
989989
if ( .not. valid ) then
990990
write( *, * ) "reverse SORT did not sort " // a_name // "."
991991
write(*,*) 'i = ', i
992-
write(*,'(a12, 2i7)') 'dummy(i-1:i) = ', dummy(i-1:i)
992+
write(*,'(a12, 2i7)') 'dummy(i-2:i-1) = ', dummy(i-2:i-1)
993993
end if
994994

995995
end subroutine test_int_sort
@@ -1174,8 +1174,8 @@ contains
11741174
write(*,*) 'i = ', i
11751175
call bitsetl_dummy(i-1)%to_string(bin_im1)
11761176
call bitsetl_dummy(i)%to_string(bin_i)
1177-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
1178-
bin_im1, bin_i
1177+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
1178+
                bin_im1, bin_i
11791179
end if
11801180
write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
11811181
'a12, " |", F10.6, " |" )' ) &
@@ -1191,8 +1191,8 @@ contains
11911191
write(*,*) 'i = ', i
11921192
call bitsetl_dummy(i-1)%to_string(bin_im1)
11931193
call bitsetl_dummy(i)%to_string(bin_i)
1194-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
1195-
bin_im1, bin_i
1194+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
1195+
                bin_im1, bin_i
11961196
end if
11971197
end subroutine test_bitsetl_sort
11981198

@@ -1261,8 +1261,8 @@ contains
12611261
write(*,*) 'i = ', i
12621262
call bitset64_dummy(i-1)%to_string(bin_im1)
12631263
call bitset64_dummy(i)%to_string(bin_i)
1264-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
1265-
bin_im1, bin_i
1264+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
1265+
                bin_im1, bin_i
12661266
end if
12671267
end subroutine test_bitset64_sort
12681268
#endif
@@ -1400,7 +1400,7 @@ contains
14001400

14011401
tdiff = 0
14021402
do i = 1, repeat
1403-
char_dummy = a
1403+
            char_dummy(0:size(a)-1) = a
14041404
call system_clock( t0, rate )
14051405

14061406
call sort_index( char_dummy, index_${namei}$, char_work, iwork_${namei}$ )
@@ -1528,8 +1528,8 @@ contains
15281528
write(*,*) 'i = ', i
15291529
call bitsetl_dummy(i-1)%to_string(bin_im1)
15301530
call bitsetl_dummy(i)%to_string(bin_i)
1531-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
1532-
bin_im1, bin_i
1531+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
1532+
                bin_im1, bin_i
15331533
end if
15341534
write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
15351535
'a12, " |", F10.6, " |" )' ) &
@@ -1659,9 +1659,9 @@ contains
16591659
real(dp) :: rate
16601660
${ti}$ :: adjoint(size(a))
16611661
${ti}$ :: iwork(size(a))
1662-
integer(int64) :: i, j
1663-
logical :: valid
1664-
1662+
integer(int64)                 :: i, j
1663+
  integer(int64) :: i_adj
1664+
        logical                        :: valid, valid_adj
16651665
ltest = .true.
16661666

16671667
tdiff = 0
@@ -2009,8 +2009,8 @@ contains
20092009
write(*,*) 'i = ', i
20102010
call bitsetl_dummy(i-1)%to_string(bin_im1)
20112011
call bitsetl_dummy(i)%to_string(bin_i)
2012-
write(*,'(a, 2(a:,1x))') 'bitsetl_dummy(i-1:i) = ', &
2013-
bin_im1, bin_i
2012+
write(*,'(a, 2(1x,a))') 'bitsetl_dummy(i-1:i) = ', &
2013+
                bin_im1, bin_i
20142014
end if
20152015
write( lun, '("| Bitset_large |", 1x, i7, 2x, "|", 1x, a15, " |", ' // &
20162016
'a12, " |", F10.6, " |" )' ) &
@@ -2166,7 +2166,7 @@ contains
21662166
end subroutine test_real_sort_adjointes_${namei}$
21672167

21682168
subroutine test_real_sort_adjoint_${namei}$( a, a_name, ltest )
2169-
integer(int32), intent(inout) :: a(:)
2169+
integer(${ki}$), intent(in) :: a(0:)
21702170
character(*), intent(in) :: a_name
21712171
logical, intent(out) :: ltest
21722172

@@ -2193,14 +2193,18 @@ contains
21932193
tdiff = tdiff/repeat
21942194

21952195
call verify_sort( dummy, valid, i )
2196-
call verify_adjoint(int(adjoint, kind=int32), dummy, valid_adj, i_adj )
2197-
2198-
ltest = (ltest .and. valid .and. valid_adj)
2199-
if ( .not. valid ) then
2200-
write( *, * ) "SORT_ADJOINT did not sort " // a_name // "."
2201-
write(*,*) 'i = ', i
2202-
write(*,'(a18, 2i7)') 'a(i-1:i) = ', a(i-1:i)
2203-
end if
2196+
        ! Check if original array indexed by adjoint matches the sorted dummy
2197+
        call verify_adjoint( a(adjoint), dummy, valid_adj, i_adj )
2198+
        ltest = (ltest .and. valid .and. valid_adj)
2199+
        if ( .not. valid ) then
2200+
            write( *, * ) "SORT_ADJOINT did not sort " // a_name // "."
2201+
            write(*,*) 'i = ', i
2202+
            write(*,'(a18, 2i7)') 'a(i-1:i) = ', a(i-1:i)
2203+
        end if
2204+
        if ( .not. valid_adj ) then
2205+
            write( *, * ) "SORT_ADJOINT adjoint mapping failed for " // a_name // "."
2206+
            write(*,*) 'i_adj = ', i_adj
2207+
        end if
22042208
if ( .not. valid_adj ) then
22052209
write( *, * ) "SORT_ADJOINT did not sort " // a_name // "."
22062210
write(*,*) 'i_adj = ', i_adj
@@ -2215,15 +2219,20 @@ contains
22152219
adjoint = real(dummy, kind=${namei}$)
22162220
call sort_adjoint( dummy, adjoint, work, iwork, reverse=.true. )
22172221

2218-
call verify_reverse_sort( dummy, valid, i )
2219-
call verify_adjoint(int(adjoint, kind=int32), dummy, valid_adj, i_adj )
2220-
ltest = (ltest .and. valid .and. valid_adj)
2221-
if ( .not. valid ) then
2222-
write( *, * ) "SORT_ADJOINT did not reverse sort " // &
2223-
a_name // "."
2224-
write(*,*) 'i = ', i
2225-
write(*,'(a18, 2i7)') 'a(i-1:i) = ', a(i-1:i)
2226-
end if
2222+
call verify_reverse_sort( dummy, valid, i )
2223+
        call verify_adjoint( a(adjoint), dummy, valid_adj, i_adj )
2224+
        ltest = (ltest .and. valid .and. valid_adj)
2225+
        if ( .not. valid ) then
2226+
            write( *, * ) "SORT_ADJOINT did not reverse sort " // &
2227+
                a_name // "."
2228+
            write(*,*) 'i = ', i
2229+
            write(*,'(a18, 2i7)') 'a(i-1:i) = ', a(i-1:i)
2230+
        end if
2231+
        if ( .not. valid_adj ) then
2232+
            write( *, * ) "SORT_ADJOINT reverse adjoint mapping failed for " // a_name // "."
2233+
            write(*,*) 'i_adj = ', i_adj
2234+
        end if
2235+
22272236
if ( .not. valid_adj ) then
22282237
write( *, * ) "SORT_ADJOINT did not reverse sort " // &
22292238
a_name // "."
@@ -2266,6 +2275,50 @@ contains
22662275
valid = .true.
22672276

22682277
end subroutine verify_adjoint
2278+
subroutine verify_real_adjoint( a, true_arr, valid, i )
2279+
        real(dp), intent(in) :: a(:)
2280+
        real(dp), intent(in) :: true_arr(:)
2281+
        logical, intent(out) :: valid
2282+
        integer(int64), intent(out) :: i
2283+
        integer(int64) :: n
2284+
2285+
        n = size( a, kind=int64 )
2286+
        valid = .false.
2287+
        do i=1, n
2288+
            if ( a(i) /= true_arr(i) ) return
2289+
        end do
2290+
        valid = .true.
2291+
    end subroutine verify_real_adjoint
2292+
2293+
    subroutine verify_char_adjoint( a, true_arr, valid, i )
2294+
        character(len=*), intent(in) :: a(:)
2295+
        character(len=*), intent(in) :: true_arr(:)
2296+
        logical, intent(out) :: valid
2297+
        integer(int64), intent(out) :: i
2298+
        integer(int64) :: n
2299+
2300+
        n = size( a, kind=int64 )
2301+
        valid = .false.
2302+
        do i=1, n
2303+
            if ( a(i) /= true_arr(i) ) return
2304+
        end do
2305+
        valid = .true.
2306+
    end subroutine verify_char_adjoint
2307+
2308+
    subroutine verify_string_adjoint( a, true_arr, valid, i )
2309+
        type(string_type), intent(in) :: a(:)
2310+
        type(string_type), intent(in) :: true_arr(:)
2311+
        logical, intent(out) :: valid
2312+
        integer(int64), intent(out) :: i
2313+
        integer(int64) :: n
2314+
2315+
        n = size( a, kind=int64 )
2316+
        valid = .false.
2317+
        do i=1, n
2318+
            if ( a(i) /= true_arr(i) ) return
2319+
        end do
2320+
        valid = .true.
2321+
    end subroutine verify_string_adjoint
22692322

22702323
subroutine verify_real_sort( a, valid, i )
22712324
real(sp), intent(in) :: a(0:)

0 commit comments

Comments
 (0)