PageRenderTime 46ms CodeModel.GetById 21ms RepoModel.GetById 1ms app.codeStats 0ms

/WPS/metgrid/src/module_mergesort.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 70 lines | 47 code | 13 blank | 10 comment | 9 complexity | 22c331075327a5fa7f7ceeb532644176 MD5 | raw file
Possible License(s): AGPL-1.0
  1. module module_mergesort
  2. contains
  3. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  4. ! Name: mergesort
  5. !
  6. ! Purpose:
  7. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  8. recursive subroutine mergesort(array, n1, n2)
  9. implicit none
  10. ! Arguments
  11. integer, intent(in) :: n1, n2
  12. integer, dimension(n1:n2), intent(inout) :: array
  13. ! Local variables
  14. integer :: i, j, k
  15. real :: rtemp
  16. real, dimension(1:n2-n1+1) :: temp
  17. if (n1 >= n2) return
  18. if (n2 - n1 == 1) then
  19. if (array(n1) < array(n2)) then
  20. rtemp = array(n1)
  21. array(n1) = array(n2)
  22. array(n2) = rtemp
  23. end if
  24. return
  25. end if
  26. call mergesort(array(n1:n1+(n2-n1+1)/2), n1, n1+(n2-n1+1)/2)
  27. call mergesort(array(n1+((n2-n1+1)/2)+1:n2), n1+((n2-n1+1)/2)+1, n2)
  28. i = n1
  29. j = n1 + ((n2-n1+1)/2) + 1
  30. k = 1
  31. do while (i <= n1+(n2-n1+1)/2 .and. j <= n2)
  32. if (array(i) > array(j)) then
  33. temp(k) = array(i)
  34. k = k + 1
  35. i = i + 1
  36. else
  37. temp(k) = array(j)
  38. k = k + 1
  39. j = j + 1
  40. end if
  41. end do
  42. if (i <= n1+(n2-n1+1)/2) then
  43. do while (i <= n1+(n2-n1+1)/2)
  44. temp(k) = array(i)
  45. i = i + 1
  46. k = k + 1
  47. end do
  48. else
  49. do while (j <= n2)
  50. temp(k) = array(j)
  51. j = j + 1
  52. k = k + 1
  53. end do
  54. end if
  55. array(n1:n2) = temp(1:k-1)
  56. end subroutine mergesort
  57. end module module_mergesort