MS-FORTRAN Ver.5.1
オプション指定に Automatic 変数が見当たりませんが、とりあえず動きます。症状からするとコンパイラの default が 77 規格通りに Automatic になっている模様。マニュアルを見れば調べられますが、段ボールの奥底に眠っているので略。
ソース・プログラム
PROGRAM MAIN PARAMETER(NMAX = 30) REAL X(NMAX), WK(NMAX) EXTERNAL QSORT N = NMAX DO 10 I = 1, N CALL RANDOM(X(I)) 10 CONTINUE CALL QSORT(N, X, WK, QSORT) PRINT *, (X(I), I = 1, N) STOP END C FORTRAN77 RECURSIVE SUBROUTINE C based on the idea by Andrew J. Miller http://www.esm.psu.edu/~ajm138/fortranexamples.html SUBROUTINE QSORT(N, X, WK, DUMSUB) REAL X(N), WK(N) EXTERNAL DUMSUB IF (N .LE. 1) RETURN K = 1 J = N PIVOT = X(1) DO 10 I = 2, N IF (X(I) .LT. PIVOT) THEN WK(K) = X(I) K = K + 1 ELSE WK(J) = X(I) J = J - 1 END IF 10 CONTINUE DO 20 I = 1, K - 1 X(I) = WK(I) 20 CONTINUE X(K) = PIVOT DO 30 I = K + 1, N X(I) = WK(I) 30 CONTINUE CALL DUMSUB(K - 1, X, WK, DUMSUB) CALL DUMSUB(N - K, X(K + 1), WK(K + 1), DUMSUB) RETURN END
Microsoft FORTRAN Powerstation 1.0a
ソース・プログラム
PROGRAM MAIN PARAMETER(NMAX = 10**2) REAL X(NMAX), WK(NMAX) EXTERNAL QSORT N = NMAX DO 10 I = 1, N CALL RANDOM(X(I)) 10 CONTINUE CALL QSORT(N, X, WK, QSORT) PRINT *, (X(I), I = 1, N) STOP END C FORTRAN77 RECURSIVE SUBROUTINE C based on the idea by Andrew J. Miller http://www.esm.psu.edu/~ajm138/fortranexamples.html SUBROUTINE QSORT(N, X, WK, DUMSUB) REAL X(N), WK(N) EXTERNAL DUMSUB IF (N .LE. 1) RETURN K = 1 J = N PIVOT = X(1) DO 10 I = 2, N IF (X(I) .LT. PIVOT) THEN WK(K) = X(I) K = K + 1 ELSE WK(J) = X(I) J = J - 1 END IF 10 CONTINUE DO 20 I = 1, K - 1 X(I) = WK(I) 20 CONTINUE X(K) = PIVOT DO 30 I = K + 1, N X(I) = WK(I) 30 CONTINUE CALL DUMSUB(K - 1, X, WK, DUMSUB) CALL DUMSUB(N - K, X(K + 1), WK(K + 1), DUMSUB) RETURN END
Microsoft FORTRAN Powerstation 4.0
ソース・プログラム
PROGRAM MAIN PARAMETER(NMAX = 10**3) REAL X(NMAX), WK(NMAX) EXTERNAL QSORT C Fortran90 : random_number call random_number(X) N = NMAX CALL QSORT(N, X, WK, QSORT) print *, x print *, any(x(1:n - 1) > x(2:)) STOP END C FORTRAN77 RECURSIVE SUBROUTINE C based on the idea by Andrew J. Miller http://www.esm.psu.edu/~ajm138/fortranexamples.html SUBROUTINE QSORT(N, X, WK, DUMSUB) REAL X(N), WK(N) EXTERNAL DUMSUB IF (N .LE. 1) RETURN K = 1 J = N PIVOT = X(1) DO 10 I = 2, N IF (X(I) .LT. PIVOT) THEN WK(K) = X(I) K = K + 1 ELSE WK(J) = X(I) J = J - 1 END IF 10 CONTINUE DO 20 I = 1, K - 1 X(I) = WK(I) 20 CONTINUE X(K) = PIVOT DO 30 I = K + 1, N X(I) = WK(I) 30 CONTINUE CALL DUMSUB(K - 1, X(1) , WK(1) , DUMSUB) CALL DUMSUB(N - K, X(K + 1), WK(K + 1), DUMSUB) RETURN END