Hatena::ブログ(Diary)

fortran66の日記

2012-05-03 FORTRAN77 での再帰 QuickSort その2

[] 77 での再帰 QuickSort を昔の処理系02:42  77 での再帰 QuickSort を昔の処理系でを含むブックマーク

MS-FORTRAN Ver.5.1

オプション指定に Automatic 変数が見当たりませんが、とりあえず動きます。症状からするとコンパイラの default が 77 規格通りに Automatic になっている模様。マニュアルを見れば調べられますが、段ボールの奥底に眠っているので略。

f:id:fortran66:20120504023429p:image

f:id:fortran66:20120504023430p:image

ソース・プログラム
      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
実行結果

f:id:fortran66:20120504023431p:image

Microsoft FORTRAN Powerstation 1.0a

Automatic 変数オプションのタブを開いている。

f:id:fortran66:20120504023432p:image

ソース・プログラム
      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

Automatic 変数オプションのタブを開いている。

f:id:fortran66:20120504023433p:image

ソース・プログラム
      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
トラックバック - http://d.hatena.ne.jp/fortran66/20120503/1336066971