Commit 0c57c62e authored by Lefebvre, Jordan P's avatar Lefebvre, Jordan P

Merge branch 'fortran_merge_sort' into 'master'

Fortran merge sort

See merge request !61
parents cbebec37 811e6784
Pipeline #20025 passed with stages
in 16 minutes and 4 seconds
......@@ -40,6 +40,7 @@ mac_llvm_testing:
- mkdir build
- cd build
- which cmake
- export radix_ENABLE_Fortran=OFF
- cmake -DDEBUG_OUTPUT=1 -DBUILDNAME=$(uname -s)-LLVM-Debug-${CI_BUILD_REF_NAME} -DCMAKE_BUILD_TYPE=DEBUG -Dradix_ENABLE_TESTS=ON -Dradix_ENABLE_SECONDARY_TESTED_CODE=ON -Dradix_ENABLE_TESTS=ON -DTPL_ENABLE_VTK=ON -Dradix_ENABLE_radixplot=OFF ..
- ctest -D ExperimentalStart -D ExperimentalBuild -D ExperimentalTest -DExperimentalMemCheck -D ExperimentalSubmit
......@@ -131,6 +132,7 @@ windows_msvc_testing:
- mkdir build
- cd build
- SET VTK_DIR=c:\vendors\cl\vtk\8.1.0\
- SET radix_ENABLE_Fortran=OFF
- cmake -DBUILD_SHARED_LIBS=ON -DBUILDNAME=Windows-CL-18-Release-%CI_BUILD_REF_NAME% -DCMAKE_BUILD_TYPE=RELEASE -Dradix_ENABLE_SECONDARY_TESTED_CODE=ON -Dradix_ENABLE_TESTS=ON -DTPL_ENABLE_VTK=ON -Dradix_ENABLE_radixplot=OFF -Dradix_ENABLE_radixglls=OFF -G "NMake Makefiles" ..
- ctest -D ExperimentalStart -D ExperimentalBuild -D ExperimentalTest -D ExperimentalSubmit
......
......@@ -64,8 +64,10 @@ MACRO(TRIBITS_REPOSITORY_SETUP_EXTRA_OPTIONS)
IF(NOT "$ENV{${PROJECT_NAME}_ENABLE_Fortran}" STREQUAL "" )
SET(${PROJECT_NAME}_ENABLE_Fortran $ENV{${PROJECT_NAME}_ENABLE_Fortran})
ELSE()
# ensure fortran compiler is set on
SET(${PROJECT_NAME}_ENABLE_Fortran OFF CACHE BOOL "" FORCE)
# allow fortran compiler to be set on
IF(NOT ${PROJECT_NAME}_ENABLE_Fortran)
SET(${PROJECT_NAME}_ENABLE_Fortran OFF CACHE BOOL "" FORCE)
ENDIF()
ENDIF()
# Set up radix cmake directory, used by default option scripts
SET(radix_CMAKE_DIR "${radix_SOURCE_DIR}/cmake" CACHE PATH "")
......
......@@ -11,6 +11,11 @@ marchingsquares.hh
marchingsquares.i.hh
)
IF(${PROJECT_NAME}_ENABLE_Fortran)
SET(SOURCE ${SOURCE}
mergesort.f90)
ENDIF()
TRIBITS_ADD_LIBRARY(radixalgorithmlib
SOURCES ${SOURCE}
NOINSTALLHEADERS ${HEADERS}
......
subroutine merge_sort(n, a, indices)
! This routine takes an input array 'a' of dimension (n)
! and an input array 'indices' of dimension (n)
! and conducts a merge sort on array 'a' while saving the original order
! to array 'indices'
! The first pass sorts each pair of consecutive elements [a(i) vs. a(i+1)].
! The second pass sorts adjacent sequences of length 2 [a(i), a(i+1) vs. a(i+2), a(i+3)]; the sequences are already ordered, due to step 1.
! The third pass sorts adjacent sequences of length 4 [a(i),...,a(i+3) vs. a(i+4),...,a(i+7)]; the sequences are already ordered, from step 2.
! This continues for L1 passes, where 2**(L1-1) < n < 2**L1. Note that n does not need to be a power of 2.
implicit none
!DEC$ ATTRIBUTES DLLEXPORT::merge_sort
integer :: i, imax, i0, j, jmax, k, L, L1, m, n
real, intent(inout) :: a(n)
integer, intent(out) :: indices(n)
real, allocatable :: b(:)
allocate (b(n))
L1 = 1
m = 1
do while (m < n) ! Determine L1 so that 2**(L1-1) < n < 2**L1
m = m + m
L1 = L1 + 1
end do
L1 = L1 - 1
m = 1
do L=1, L1
k=1
do i0=1, n-m+1, m+m
i=i0
j=i+m
imax=j
jmax=j+m
if(imax > n) imax = n + 1
if(jmax > n) jmax = n + 1
do while(i < imax .and. j < jmax)
if(a(i) < a(j)) then
b(k) = a(i)
indices(k) = i
i = i + 1
else
b(k) = a(j)
indices(k) = j
j = j + 1
end if
k = k + 1
end do
do while(i < imax)
b(k) = a(i)
indices(k) = i
i = i + 1
k = k + 1
end do
do while(j < jmax)
b(k) = a(j)
indices(k) = j
j = j + 1
k = k + 1
end do
end do
m = m + m
a = b
end do
if(allocated(b)) deallocate(b)
return
end subroutine merge_sort
......@@ -3,3 +3,9 @@ INCLUDE(GoogleTest)
ADD_GOOGLE_TEST(tstOrdering.cc NP 1)
ADD_GOOGLE_TEST(tstMarchingSquares.cc NP 1)
ADD_GOOGLE_TEST(tstChaikins.cc NP 1)
IF(${PROJECT_NAME}_ENABLE_Fortran)
TRIBITS_ADD_EXECUTABLE_AND_TEST(tstMergeSortFortran
SOURCES tstMergeSort.f90
LINKER_LANGUAGE Fortran
)
ENDIF()
Program run_merge
implicit none
interface
subroutine merge_sort(n, a, indices)
integer :: n
real, intent(inout) :: a(n)
integer, intent(out) :: indices(n)
end subroutine
end interface
integer :: n, i
character (len=10) :: d1, d2, d3
integer :: time(8)
real :: dtime1, dtime2
real, allocatable :: a(:)
integer, allocatable :: indices(:)
call DATE_AND_TIME(d1, d2, d3, time)
dtime1 = time(6)*60.+time(7)+time(8)/1000.
n = 10000
allocate (a(n))
allocate (indices(n))
! avoid unitialised value warning
indices = 0
do i=1, time(7)
call RANDOM_NUMBER(dtime2)
end do
call RANDOM_NUMBER(a)
do i=1, n
a(i) = a(i) * n / 10.
end do
! print "(10f12.3)", (a(i,1), i=1, 10), (a(i,2), i=1, 10)
! a = a * N / 10.
call DATE_AND_TIME(d1, d2, d3, time)
dtime2 = time(6)*60.+time(7)+time(8)/1000.
dtime1 = dtime2 - dtime1
print *, "setup time (s) =", dtime1
print *, "First/Last 10 elements before sorting"
print "(10f12.3/10i10)", (a(i), i=1, 10), (indices(i), i=1, 10)
print "(10f12.3/10i10)", (a(i), i=n-9, n), (indices(i), i=n-9, n)
call merge_sort(n, a, indices)
call DATE_AND_TIME(d1, d2, d3, time)
print *, "First/Last 10 elements after sorting"
print "(10f12.3/10i10)", (a(i), i=1, 10), (indices(i), i=1, 10)
print "(10f12.3/10i10)", (a(i), i=n-9, n), (indices(i), i=n-9, n)
dtime2 = time(6)*60.+time(7)+time(8)/1000.-dtime2
print *, "sort time (s) =", dtime2
do i=1, (n-1)
! check order of entire array
if(a(i) > a(i+1)) then
print *, "Element (",i,") is greater than element (",(i+1),")"
stop 99
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