# Example 9.7

#### FORTRAN version

```!
! =====> 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: '
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:

```[FTN90 Version 1.12 Copyright (c)SALFORD SOFTWARE LTD 1992  &  ]
[                   (c)THE NUMERICAL ALGORITHMS GROUP 1991,1992]
NO ERRORS  [FTN90]
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
```

#### Pascal version

```{256}
{12}
{}
PROGRAM p96 (input, output);
TYPE
listarray = ARRAY[1..1000] OF INTEGER;
VAR
list : listarray;
ncomp, nswap, n, i : INTEGER;

PROCEDURE swap (VAR k, l : INTEGER);
VAR
temp : INTEGER;
BEGIN
temp := k;
k := l;
l := temp
END;

PROCEDURE sort1 (VAR list : listarray; n : INTEGER);
VAR
i, j : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
FOR i := 1 TO n-1 DO
FOR j := i+1 TO n DO
BEGIN
ncomp := ncomp + 1;
IF (list[i] > list[j]) THEN
BEGIN
swap (list[i], list[j]);
nswap := nswap + 1
END
END
END;

PROCEDURE bsort1 (VAR list : listarray; n : INTEGER);
VAR
i, k : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
REPEAT
k := 0;
FOR i := 1 TO n-1 DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := 1
END
END
UNTIL k = 0
END;

PROCEDURE bsort2 (VAR list : listarray; n : INTEGER);
VAR
last, k, i : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
last := n - 1;
REPEAT
k := 0;
FOR i := 1 TO last DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := i
END
END;
last := k
UNTIL k = 0
END;

PROCEDURE bsortr (VAR list : listarray; VAR l, m, k : INTEGER);

{  Right bubble sort  }

VAR
i : INTEGER;
BEGIN
m := m - 1;
k := 0;
FOR i := l TO m DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := i
END
END;
m := k
END;

PROCEDURE bsortl (VAR list : listarray; VAR l, m, k : INTEGER);

{  Left bubble sort  }

VAR
i : INTEGER;
BEGIN
l := l + 1;
k := 0;
FOR i := m DOWNTO l DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] < list[i-1] ) THEN
BEGIN
swap (list[i], list[i-1]);
nswap := nswap + 1;
k := i
END
END;
l := k
END;

PROCEDURE shake (VAR list : listarray; n : INTEGER);
VAR
left, right, i, k : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
left := 1;
right := n;
i := 1;
REPEAT
bsortr (list, left, right, k);
IF (k <> 0) THEN
bsortl (list, left, right, k);
i := i + 1;
UNTIL ( (i > n) OR (k = 0) )
END;

PROCEDURE shell (VAR list : listarray; n : INTEGER);
VAR
m, i, j : INTEGER;
done : BOOLEAN;
BEGIN
ncomp := 0;
nswap := 0;
m := n;
REPEAT
m := (m + 2) div 3;
FOR i := m+1 TO n DO
BEGIN
j := i;
done := false;
WHILE ((j >= m+1) AND (NOT done)) DO
BEGIN
ncomp := ncomp + 1;
IF ( list[j-m] < list[j] ) THEN
done := true
ELSE
BEGIN
swap (list[j], list[j-m]);
nswap := nswap + 1
END;
j := j - m
END
END;
UNTIL m <= 1
END;

PROCEDURE printinfo;
BEGIN
writeln ( 'number of comparisons = ', ncomp:5 );
writeln ( 'number of exchanges = ', nswap:5 );
writeln;
writeln
END;

PROCEDURE gen ( VAR list : listarray ;
n : INTEGER );
VAR
i : INTEGER;
BEGIN
{
Random (x) returns a random integer between 0 and x not inclusive
Randomize resets the random generator
}
randomize;
FOR i := 1 TO n DO
list[i] := random ( n + 1 )
END;

BEGIN
WHILE ( NOT eof ) DO
BEGIN

readln ( n );
gen ( list, n );
sort1 ( list, n );
writeln ( 'Sort1 : ' );
printinfo;
gen ( list, n );
bsort1 ( list, n );
writeln ( 'Bsort1 : ');
printinfo;
gen ( list, n );
bsort2 (list, n );
writeln ( 'Bsort2 : ');
printinfo;
gen ( list, n );
shake ( list, n );
writeln ( 'Shake : ' );
printinfo;
gen ( list, n );
shell ( list, n );
writeln ( 'Shell : ' );
printinfo
END
END.

```

DATA:

```10
100```

Come back to the previous page