Commit 87b3af93 authored by Lefebvre, Jordan P's avatar Lefebvre, Jordan P

Merge branch 'fortran_merge_sort' into 'master'

Fixing and adding unit test coverage to merge_sort indices permutation results.

See merge request !62
parents 0c57c62e 89f24f1c
Pipeline #20045 passed with stages
in 15 minutes and 15 seconds
...@@ -15,7 +15,12 @@ ...@@ -15,7 +15,12 @@
real, intent(inout) :: a(n) real, intent(inout) :: a(n)
integer, intent(out) :: indices(n) integer, intent(out) :: indices(n)
real, allocatable :: b(:) real, allocatable :: b(:)
integer, allocatable :: ai(:)
allocate (b(n)) allocate (b(n))
allocate (ai(n))
do i=1, n
ai(i) = i
end do
L1 = 1 L1 = 1
m = 1 m = 1
do while (m < n) ! Determine L1 so that 2**(L1-1) < n < 2**L1 do while (m < n) ! Determine L1 so that 2**(L1-1) < n < 2**L1
...@@ -36,32 +41,34 @@ ...@@ -36,32 +41,34 @@
do while(i < imax .and. j < jmax) do while(i < imax .and. j < jmax)
if(a(i) < a(j)) then if(a(i) < a(j)) then
b(k) = a(i) b(k) = a(i)
indices(k) = i indices(k) = ai(i)
i = i + 1 i = i + 1
else else
b(k) = a(j) b(k) = a(j)
indices(k) = j indices(k) = ai(j)
j = j + 1 j = j + 1
end if end if
k = k + 1 k = k + 1
end do end do
do while(i < imax) do while(i < imax)
b(k) = a(i) b(k) = a(i)
indices(k) = i indices(k) = ai(i)
i = i + 1 i = i + 1
k = k + 1 k = k + 1
end do end do
do while(j < jmax) do while(j < jmax)
b(k) = a(j) b(k) = a(j)
indices(k) = j indices(k) = ai(j)
j = j + 1 j = j + 1
k = k + 1 k = k + 1
end do end do
end do end do
m = m + m m = m + m
a = b a = b
ai = indices
end do end do
if(allocated(b)) deallocate(b) if(allocated(b)) deallocate(b)
if(allocated(ai)) deallocate(ai)
return return
end subroutine merge_sort end subroutine merge_sort
Program run_merge Program run_merge
implicit none implicit none
interface interface
subroutine merge_sort(n, a, indices) subroutine merge_sort(n, a, indices)
integer :: n integer :: n
real, intent(inout) :: a(n) real, intent(inout) :: a(n)
integer, intent(out) :: indices(n) integer, intent(out) :: indices(n)
end subroutine end subroutine
end interface end interface
integer :: n, i integer :: n, i
character (len=10) :: d1, d2, d3 character (len=10) :: d1, d2, d3
integer :: time(8) integer :: time(8)
real :: dtime1, dtime2 real :: dtime1, dtime2
real, allocatable :: a(:) real, allocatable :: a(:)
integer, allocatable :: indices(:) real, allocatable :: blessed(:)
call DATE_AND_TIME(d1, d2, d3, time) integer, allocatable :: indices(:)
dtime1 = time(6)*60.+time(7)+time(8)/1000. call DATE_AND_TIME(d1, d2, d3, time)
n = 10000 dtime1 = time(6)*60.+time(7)+time(8)/1000.
allocate (a(n)) n = 1000
allocate (indices(n)) allocate (a(n))
! avoid unitialised value warning allocate (blessed(n))
indices = 0 allocate (indices(n))
do i=1, time(7) ! avoid unitialised value warning
call RANDOM_NUMBER(dtime2) indices = 0
end do do i=1, time(7)
call RANDOM_NUMBER(a) call RANDOM_NUMBER(dtime2)
do i=1, n end do
a(i) = a(i) * n / 10. call RANDOM_NUMBER(a)
end do do i=1, n
! print "(10f12.3)", (a(i,1), i=1, 10), (a(i,2), i=1, 10) a(i) = a(i) * n / 10.
! a = a * N / 10. end do
call DATE_AND_TIME(d1, d2, d3, time) ! save this original version of a as blessed version
dtime2 = time(6)*60.+time(7)+time(8)/1000. blessed = a
dtime1 = dtime2 - dtime1 ! print "(10f12.3)", (a(i,1), i=1, 10), (a(i,2), i=1, 10)
print *, "setup time (s) =", dtime1 ! a = a * N / 10.
print *, "First/Last 10 elements before sorting" call DATE_AND_TIME(d1, d2, d3, time)
print "(10f12.3/10i10)", (a(i), i=1, 10), (indices(i), i=1, 10) dtime2 = time(6)*60.+time(7)+time(8)/1000.
print "(10f12.3/10i10)", (a(i), i=n-9, n), (indices(i), i=n-9, n) dtime1 = dtime2 - dtime1
call merge_sort(n, a, indices) print *, "setup time (s) =", dtime1
call DATE_AND_TIME(d1, d2, d3, time) print *, "First/Last 10 elements before sorting"
print *, "First/Last 10 elements after sorting" print "(10f12.3/10i12)", (a(i), i=1, 10), (indices(i), i=1, 10)
print "(10f12.3/10i10)", (a(i), i=1, 10), (indices(i), i=1, 10) print "(10f12.3/10i12)", (a(i), i=n-9, n), (indices(i), i=n-9, n)
print "(10f12.3/10i10)", (a(i), i=n-9, n), (indices(i), i=n-9, n) call merge_sort(n, a, indices)
dtime2 = time(6)*60.+time(7)+time(8)/1000.-dtime2 call DATE_AND_TIME(d1, d2, d3, time)
print *, "sort time (s) =", dtime2 print *, "First/Last 10 elements after sorting"
do i=1, (n-1) print "(10f12.3/10i12)", (a(i), i=1, 10), (indices(i), i=1, 10)
! check order of entire array print "(10f12.3/10i12)", (a(i), i=n-9, n), (indices(i), i=n-9, n)
if(a(i) > a(i+1)) then dtime2 = time(6)*60.+time(7)+time(8)/1000.-dtime2
print *, "Element (",i,") is greater than element (",(i+1),")" print *, "sort time (s) =", dtime2
stop 99 do i=1, (n-1)
endif ! check order of entire array
end do if(a(i) > a(i+1)) then
stop print *, "Element (",i,") is greater than element (",(i+1),")"
end program run_merge stop 99
endif
end do
! check that the lookup works now
!print *, "unsorted:(10f3.2)", (blessed(i), i=1, n)
!print *, "Indices:(10i5)", (indices(i), i=1, n)
!print *, "sorted:(10f3.2)", (a(i), i=1, n)
do i=1, n
if(blessed(indices(i)) /= a(i)) then
print *, "Index (",i,") doesn't not match unsorted(",blessed(indices(i)),") with sorted(",a(i),")"
stop 100
endif
end do
stop
end program run_merge
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment