Commit 811e6784 by Lefebvre, Jordan P

### Running dos2unix on mergesort.f90 and adding declspec export for shared windows build.

parent d86eca47
Pipeline #20021 passed with stages
in 15 minutes and 30 seconds
 subroutine merge_sort(n, a, indices) subroutine merge_sort(n, a, indices) ! This routine takes an input array 'a' of dimension (n) ! This routine takes an input array 'a' of dimension (n) ! and an input array 'indices' of dimension (n) ! and an input array 'indices' of dimension (n) ! and conducts a merge sort on array 'a' while saving the original order ! and conducts a merge sort on array 'a' while saving the original order ! to array 'indices' ! to array 'indices' ! The first pass sorts each pair of consecutive elements [a(i) vs. a(i+1)]. ! 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 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. ! 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. ! 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 implicit none integer :: i, imax, i0, j, jmax, k, L, L1, m, n !DEC\$ ATTRIBUTES DLLEXPORT::merge_sort real, intent(inout) :: a(n) integer :: i, imax, i0, j, jmax, k, L, L1, m, n integer, intent(out) :: indices(n) real, intent(inout) :: a(n) real, allocatable :: b(:) integer, intent(out) :: indices(n) allocate (b(n)) real, allocatable :: b(:) L1 = 1 allocate (b(n)) m = 1 L1 = 1 do while (m < n) ! Determine L1 so that 2**(L1-1) < n < 2**L1 m = 1 m = m + m do while (m < n) ! Determine L1 so that 2**(L1-1) < n < 2**L1 L1 = L1 + 1 m = m + m end do L1 = L1 + 1 L1 = L1 - 1 end do m = 1 L1 = L1 - 1 do L=1, L1 m = 1 k=1 do L=1, L1 do i0=1, n-m+1, m+m k=1 i=i0 do i0=1, n-m+1, m+m j=i+m i=i0 imax=j j=i+m jmax=j+m imax=j if(imax > n) imax = n + 1 jmax=j+m if(jmax > n) jmax = n + 1 if(imax > n) imax = n + 1 do while(i < imax .and. j < jmax) if(jmax > n) jmax = n + 1 if(a(i) < a(j)) then do while(i < imax .and. j < jmax) b(k) = a(i) if(a(i) < a(j)) then indices(k) = i b(k) = a(i) i = i + 1 indices(k) = i else i = i + 1 b(k) = a(j) else indices(k) = j b(k) = a(j) j = j + 1 indices(k) = j end if j = j + 1 k = k + 1 end if end do k = k + 1 do while(i < imax) end do b(k) = a(i) do while(i < imax) indices(k) = i b(k) = a(i) i = i + 1 indices(k) = i k = k + 1 i = i + 1 end do k = k + 1 do while(j < jmax) end do b(k) = a(j) do while(j < jmax) indices(k) = j b(k) = a(j) j = j + 1 indices(k) = j k = k + 1 j = j + 1 end do k = k + 1 end do end do m = m + m end do a = b m = m + m end do a = b if(allocated(b)) deallocate(b) end do return if(allocated(b)) deallocate(b) end subroutine merge_sort return end subroutine merge_sort
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!