挿入ソート

再帰を使ったので、すぐスタックあふれで死ぬｗ
コンパイラオプション /assume:realloc_lhs　が必要。

 module m_isort
      implicit none
    contains
      recursive function isort(arr) result(res)
        real, intent(in)  :: arr(:)
        real, allocatable :: res(:)
        if (size(arr) <= 1) then
          res = arr
        else
          res = insert( arr(1), isort(arr(2:)) )
        end if
        return
      end function isort
    
      function insert(x, arr) result(res)
        real, intent(in) :: x, arr(:)   
        real, allocatable :: res(:)
        integer :: i, n
        n = size(arr)
        do i = 1, n 
          if ( x < arr(i) ) exit
        end do
        res = [ arr(:i - 1), x, arr(i:) ]
        return
      end function insert
    
    end module m_isort
    
    program InsertionSort
      use m_isort
      implicit none
      real, allocatable :: x(:), y(:)
      call random_seed()
      allocate( x(3000) )
      call random_number(x)
      y = isort( x ) 
      print *, x
      print *
      print *, y
      stop
    end program InsertionSort

2011-10-30 少し修正。余分な行削除。