P97.F90

Demo of various sorting techniques


!
! =====> 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

Come back to the previous page

Page builder: Charles Boivin

Last modified: 11/07/95