fortran66のブログ

fortran について書きます。

QuickSort

Intelコンパイラでの文法厳密チェックオプションで引っかかるので調べたところ、『Fortran95/2003 Explained』6-11(p.116)に、確かにそのように書いてありました。しかし、根拠はよく分かりません。 これを満たすように少し書き換えてみました。

Fortran 95 handbook: complete ISO/ANSI reference』p.668 R1215 「Constraints: A non-intrinsic elemental procedure shall not be used as actual argument. 」
http://books.google.co.jp/books?id=AUx7vKIiuvwC&printsec=frontcover#v=onepage&q=&f=false

実行結果


ソース

MODULE m_sort
IMPLICIT NONE
CONTAINS
!-----------------------------------------------------
RECURSIVE FUNCTION qsort2(x, f) RESULT(res)
REAL, INTENT(IN) :: x(:)
REAL :: res(SIZE(x))
INTEGER :: i
LOGICAL :: mask(SIZE(x) - 1)
INTERFACE 
 PURE LOGICAL FUNCTION f(x1, x2) ! ELEMENTAL shall not be used : MR&C 6-11 p.116 : ISO R1215
 REAL, INTENT(IN) :: x1, x2
 END FUNCTION f
END INTERFACE
IF (SIZE(x) > 1) THEN
 FORALL (i = 2:SIZE(x)) mask(i - 1) = f(x(i), x(1)) 
 res = (/  qsort2( PACK(x(2:), mask), f ), x(1), qsort2( PACK(x(2:), .NOT. mask), f )  /)  
ELSE
 res = x
END IF
RETURN
END FUNCTION qsort2
!-----------------------------------------------------
END MODULE m_sort
!========================================================
MODULE m_func
IMPLICIT NONE
CONTAINS
!-----------------------------------------------------
PURE LOGICAL FUNCTION lt(a, b) 
REAL, INTENT(IN) :: a, b
IF (a < b) THEN
 lt = .TRUE.
ELSE
 lt = .FALSE.
ENDIF
RETURN
END FUNCTION lt
!-----------------------------------------------------
PURE LOGICAL FUNCTION gt(a, b)
REAL, INTENT(IN) :: a, b
IF (a > b) THEN 
 gt = .TRUE.
ELSE
 gt = .FALSE.
ENDIF
RETURN
END FUNCTION gt
!-----------------------------------------------------
END MODULE m_func
!========================================================
PROGRAM sort
USE m_sort
USE m_func
IMPLICIT NONE
REAL :: x(40)
CALL RANDOM_SEED()
CALL RANDOM_NUMBER(x)
PRINT *, qsort2(x, lt)
PRINT *
PRINT *, qsort2(x, gt)
STOP
END PROGRAM sort