Quick sortがShell sortに負けているので．．

要素数10**8程度ではShell sortも健闘してQuick sortと計算時間が変わりません。しかし、今のプログラムではQuick sortは余計なメモリーを食いすぎてこれ以上の要素数を計算できません。

ここではQuick sortの小手先改良を行います。先日、要素数が少なくなったときにBubble sort類似のsortを用いることで加速を図りましたが、ここをもう少しだけ改良します。

■実行結果

■ソースプログラム

必要なオプション
/assume:realloc_lhs
/heap-arrays100000

MODULE m_sort
  IMPLICIT NONE
 CONTAINS
!
  RECURSIVE PURE FUNCTION qsort(x) RESULT(res)
    REAL, ALLOCATABLE :: res(:)
    REAL, INTENT(IN) :: x(:)
    
    IF (SIZE(x) <= 100) THEN
      res = n2sort(x)
    ELSE
      res = [ qsort( PACK(x(2:), x(2:) <  x(1)) ), x(1), qsort( PACK(x(2:), x(2:) >= x(1)) ) ]
    END IF

    RETURN
  END FUNCTION qsort

  PURE FUNCTION n2sort(x)
    REAL, ALLOCATABLE :: n2sort(:)
    REAL, INTENT(IN) :: x(:)
    REAL :: tmp
    INTEGER :: i, j
    
    n2sort = x
    DO i = 1, SIZE(x) - 1
     j = MINLOC(n2sort(i:), 1) + i - 1
     tmp       = n2sort(i)
     n2sort(i) = n2sort(j)
     n2sort(j) = tmp
    END DO
    
    RETURN
  END FUNCTION n2sort

END MODULE m_sort
!========================================================
PROGRAM sort
 USE m_sort
  IMPLICIT NONE
  REAL, ALLOCATABLE :: x(:), y(:)
  REAL :: t0, t1
  INTEGER :: i

  CALL RANDOM_SEED()
  DO i = 0, 8
    ALLOCATE( x(10**i) )
    CALL RANDOM_NUMBER(x)
    CALL CPU_TIME(t0)
    y = qsort(x)
    CALL CPU_TIME(t1)
    PRINT *, i, 10**i, t1 - t0
    DEALLOCATE( x, y )
  END DO

  STOP
END PROGRAM sort