!
! =====> Program - P97.F90
!
PROGRAM SrtDmo
! Program to demonstrate a number of simple
! sorting algorithms. N random integers are
! to be sorted in increasing order (from smallest
! to largest) in an array A.
PARAMETER (NMax = 1000)
INTEGER A(NMax), A0(NMax)
PRINT *, 'This is Program >> P97 = Sorting Demo'
!
! Tell program where data for READ * is coming from
OPEN(UNIT=5, FILE='P97.DAT') ! UNIT=5 is the default input
!
PRINT *, 'Number of elements to sort: '
READ *, N
Print *, N
Print *
CALL IniAry(A0, N)
CALL PrnAry(A0, N)
! Repeat for each sorting method
PRINT *, 'Bubble'
CALL CpyAry(A0, A, N)
CALL Bubble(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Insertion'
CALL CpyAry(A0, A, N)
CALL Insert(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Selection'
CALL CpyAry(A0, A, N)
CALL Select(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Shell'
CALL CpyAry(A0, A, N)
CALL Shell(A, N)
CALL PrnAry(A, N)
Print *
STOP
END
! SUPPORT ROUTINES
SUBROUTINE IniAry(A, N)
! Initializes N elements of array A to random
! non-negative integers.
PARAMETER (MaxInt = 32700)
INTEGER A(N), Seed
Seed = 31415
L1: DO I = 1, N
A(I) = ABS(MOD(INT(URand(Seed) * MaxInt) ,MaxInt))
END DO L1
RETURN
END
SUBROUTINE CpyAry(A0, A, N)
! Copy elements 1..N of array A0 to A.
INTEGER A0(N), A(N)
L1: DO I = 1, N
A(I) = A0(I)
END DO L1
RETURN
END
SUBROUTINE PrnAry(A, N)
! Prints the N elements of array A.
INTEGER A(N)
L1: DO I = 1, N
PRINT 101, I, A(I)
END DO L1
RETURN
101 FORMAT(1X, 'A(', I3, ') = ', I9)
END
SUBROUTINE Swap(I, J)
! Exchanges the integers I and J.
ITemp = I
I = J
J = ITemp
RETURN
END
! ALGORITHMS
SUBROUTINE Bubble(A, N)
INTEGER A(N)
! Make N-1 passes through the array.
! On pass i, "bubble" the next smallest element
! up from the end of the array to position i.
L1: DO I = 1, N-1
L2: DO J = N, I+1, -1
IF (A(J) < A(J-1)) THEN
CALL Swap(A(J), A(J-1))
ENDIF
END DO L2
END DO L1
RETURN
END
SUBROUTINE Insert(A, N)
INTEGER A(N)
! Make repeated passes through the array.
! On pass i, place the i'th element in its
! proper sorted position amongst the (sorted)
! A(1),...,A(i-1).
L1: DO I = 2, N
J = I
20 IF (A(J) >= A(J-1)) CYCLE
CALL Swap(A(J), A(J-1))
J = J-1
IF (J > 1) GO TO 20
END DO L1
RETURN
END
SUBROUTINE Select(A, N)
INTEGER A(N)
! Make N-1 passes through the array.
! On pass i, find the smallest element in
! A(i+1),...,A(N) and swap it with A(i),
! leaving the elements A(1),...,A(i) in their
! final, sorted order.
L1: DO I = 1, N-1
LowIdx = I
LowKey = A(I)
L2: DO J = I+1, N
IF (A(J) .LT. LowKey) THEN
LowKey = A(J)
LowIdx = J
ENDIF
END DO L2
CALL Swap(A(I), A(LowIdx))
END DO L1
RETURN
END
SUBROUTINE Shell(A, N)
INTEGER A(N)
! Incr is the number of positions separating
! elements of a particular tuple.
Incr = N / 2
! Make passes for Incr = N DIV 2, N DIV 4,
! N DIV 8,..., 1, and use Insertion Sort on
! elements separated by distances Incr
! on each pass.
DO WHILE (Incr > 0)
L1: DO I = Incr+1, N
J = I - Incr
15 IF (J <= 0) CYCLE
IF (A(J) > A(J+Incr)) THEN
CALL Swap(A(J), A(J+Incr))
J = J - Incr
ELSE
J = 0
ENDIF
GO TO 15
END DO L1
Incr = Incr / 2
END DO
RETURN
END
!
!
REAL FUNCTION URAND( XN )
INTEGER XN
!
! Uniform random number generator based on techniques described
! in "The Art of Computer Programming", Vol.2, Knuth.
!
! Xn+1 = a*Xn + c mod m
! where
! Xn is the seed supplied by the caller
! m = 2**31
! a = 2147437301
! c = 453816693
!
! 'a' satisfies the following:
!
! max( sm, m/10 ) < a < m - sm, where sm = square root of m
! a mod 8 = 5
!
! 'c' is computed as follows:
!
! c = idnint( 2d0**31 * ( .5d0 - dsqrt( 3d0 ) / 6d0 ) ) + 1
!
! Note: Integer arithmetic is automatically done modulo 2**31.
!
INTEGER A, M, C
DATA A/2147437301/
DATA M/80000000/
DATA C/453816693/
XN = A * XN + C
IF( XN < 0 ) XN = XN + M
URAND = XN / 2.0**31
END
DATA:
10
OUTPUT:
Program entered
This is Program >> P97 = Sorting Demo
Number of elements to sort:
10
A( 1) = 17439
A( 2) = 4611
A( 3) = 15716
A( 4) = 12578
A( 5) = 19692
A( 6) = 3013
A( 7) = 144
A( 8) = 26656
A( 9) = 2094
A( 10) = 28624
Bubble
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Insertion
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Selection
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Shell
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Fortran-90 STOP
Page builder: Charles Boivin
Last modified: 11/07/95