metgrid/src/module_mergesort.F

   1 module module_mergesort
   2
   3    contains
   4
   5    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   6    ! Name: mergesort
   7    !
   8    ! Purpose:
   9    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10    recursive subroutine mergesort(array, n1, n2)
  11
  12       implicit none
  13
  14       ! Arguments
  15       integer, intent(in) :: n1, n2
  16       integer, dimension(n1:n2), intent(inout) :: array
  17
  18       ! Local variables
  19       integer :: i, j, k
  20       real :: rtemp
  21       real, dimension(1:n2-n1+1) :: temp
  22
  23       if (n1 >= n2) return
  24
  25       if (n2 - n1 == 1) then
  26          if (array(n1) < array(n2)) then
  27             rtemp = array(n1)
  28             array(n1) = array(n2)
  29             array(n2) = rtemp
  30          end if
  31          return
  32       end if
  33
  34       call mergesort(array(n1:n1+(n2-n1+1)/2), n1, n1+(n2-n1+1)/2)
  35       call mergesort(array(n1+((n2-n1+1)/2)+1:n2), n1+((n2-n1+1)/2)+1, n2)
  36
  37       i = n1
  38       j = n1 + ((n2-n1+1)/2) + 1
  39       k = 1
  40       do while (i <= n1+(n2-n1+1)/2 .and. j <= n2)
  41          if (array(i) > array(j)) then
  42             temp(k) = array(i)
  43             k = k + 1
  44             i = i + 1
  45          else
  46             temp(k) = array(j)
  47             k = k + 1
  48             j = j + 1
  49          end if
  50       end do
  51
  52       if (i <= n1+(n2-n1+1)/2) then
  53          do while (i <= n1+(n2-n1+1)/2)
  54             temp(k) = array(i)
  55             i = i + 1
  56             k = k + 1
  57          end do
  58       else
  59          do while (j <= n2)
  60             temp(k) = array(j)
  61             j = j + 1
  62             k = k + 1
  63          end do
  64       end if
  65
  66       array(n1:n2) = temp(1:k-1)
  67
  68    end subroutine mergesort
  69
  70 end module module_mergesort